# #############################################################################
#
# SAOTNG.GUI  -- Default GUI for the saotng image display server.
#
# Eric Mandel (SAO) and Saleem Mukhtar (JPL)
# Revision 1.7 		circa 4/97
# Revision 1.7.3	circa 6/98
#
# To use this GUI in SAOtng, you can do one of two things:
#
# 1. Run the saotng script with the -gui switch to load this GUI each time:
#
#	saotng -gui <pathname of this GUI file>
#
# 2. Rebuild SAOtng to load this file by default (if you have source code):
#
#	cp -p <this file>  <...>/saord/SAOtng/.
#	cd <...>/saord/SAOtng/.
#	make
#	make install
#	...
#
#    You then can run SAOtng without the -gui switch:
#
#	saotng
#
# #############################################################################

#
# the command to reset the widget server
#
reset-server

# #############################################################################
#
# Widget definitions
#
# #############################################################################

set SAOtngResources {
    *objects:\
	toplevel	Form		topForm\
	topForm		Form		menuForm\
	topForm		Viewport	aV\
	topForm		Form		imageForm\
	topForm		Form		infoForm\
	topForm		TextButton	helpButton\
\
	menuForm	TextButton	imageButton\
	menuForm	TextButton	frameButton\
	menuForm	TextButton	colorButton\
	menuForm	TextButton	markerButton\
	menuForm	TextButton	zoomButton\
	menuForm	TextButton	scaleButton\
	menuForm	TextButton	coordsButton\
	menuForm	TextButton	analButton\
\
	menuForm	Label		imageLabel\
	menuForm	Label		frameLabel\
	menuForm	Label		colorLabel\
	menuForm	Label		markerLabel\
	menuForm	Label		zoomLabel\
	menuForm	Label		scaleLabel\
	menuForm	Label		coordsLabel\
	menuForm	Label		analLabel\
\
	aV		Form		aF\
	aF		TextButton	aB1\
	aF		TextButton	aB2\
	aF		TextButton	aB3\
	aF		TextButton	aB4\
	aF		TextButton	aB5\
	aF		TextButton	aB6\
	aF		TextButton	aB7\
	aF		TextButton	aB8\
	aF		TextButton	aB9\
	aF		TextButton	aB10\
	aF		TextButton	aB11\
	aF		TextButton	aB12\
	aF		TextButton	aB13\
	aF		TextButton	aB14\
	aF		TextButton	aB15\
	aF		TextButton	aB16\
	aF		TextButton	aB17\
	aF		TextButton	aB18\
	aF		TextButton	aB19\
	aF		TextButton	aB20\
	aF		TextButton	aB21\
	aF		TextButton	aB22\
	aF		TextButton	aB23\
	aF		TextButton	aB24\
	aF		TextButton	aB25\
\
	imageForm	Gterm		imagewin\
	imageForm	Gterm		colorbar\
	infoForm	AsciiText	scaleSamples\
	infoForm	AsciiText	imageTitle\
\
	toplevel	TopLevelShell	controlShell\
	controlShell	Layout		controlPanel\
	controlPanel	Group		viewBox\
	controlPanel	Group		wcsBox\
	controlPanel	Group		enhancementBox\
	controlPanel	Group		blinkBox\
	controlPanel	Group		optionsBox\
	controlPanel	Frame		controlBox\
\
	viewBox		Layout		view\
	view		Group		frameSelect\
	frameSelect	Layout		frameBox\
	frameBox	TextToggle	frame1\
	frameBox	TextToggle	frame2\
	frameBox	TextToggle	frame3\
	frameBox	TextToggle	frame4\
	frameBox	Command		prevFrame\
	frameBox	Command		nextFrame\
	view		Frame		frameDataBox\
	frameDataBox	TextBox		frameData\
	view		Group		zoomBox\
	zoomBox		Layout		zoomLayout\
	zoomLayout	TextButton	toggleZoom\
	zoomLayout	TextButton	zoomIn\
	zoomLayout	Command		x1\
	zoomLayout	Command		z2\
	zoomLayout	Command		z3\
	zoomLayout	Command		z4\
	zoomLayout	Command		z5\
	zoomLayout	Command		z8\
	zoomLayout	TextButton	zoomOut\
	zoomLayout	TextButton	centerFrame\
	zoomLayout	Command		d2\
	zoomLayout	Command		d3\
	zoomLayout	Command		d4\
	zoomLayout	Command		d5\
	zoomLayout	Command		d8\
	view		Layout		viewButtons\
	viewButtons	TextButton	aspect\
	viewButtons	TextButton	flipX\
	viewButtons	TextButton	flipY\
	viewButtons	TextButton	flipXY\
	viewButtons	TextButton	clearframe\
	viewButtons	TextButton	fitframe\
\
	wcsBox		AsciiText	wcstext\
\
	enhancementBox	Layout		enhance\
	enhance		Scrollbar2	colorlistScroll\
	enhance		Frame		colorlistFrame\
	colorlistFrame	Porthole	colorlistPort\
	colorlistPort	MultiList	colorlist\
	enhance		Frame		colordataFrame\
	colordataFrame	Layout		colordataLayout\
	colordataLayout	TextBox		colordata\
	colordataLayout	TextBox		colordata2\
	enhance		Label		contrastLabel\
	enhance		Slider2d	contrastSlider\
	enhance		Label		maxcontrastLabel\
	enhance		Slider2d	maxcontrastSlider\
	enhance		Label		brightnessLabel\
	enhance		Slider2d	brightnessSlider\
	enhance		TextToggle	invertButton\
\
	blinkBox	Layout		blink\
	blink		Label		blinkFramesLabel\
	blink		Command		blinkFrame1\
	blink		Command		blinkFrame2\
	blink		Command		blinkFrame3\
	blink		Command		blinkFrame4\
	blink		TextButton	blinkReset\
	blink		Label		blinkRateLabel\
	blink		Frame		BRframe\
	BRframe		Layout		BRlayout\
	BRlayout	Arrow		BRdecrease\
	BRlayout	TextBox		BRtext\
	BRlayout	Arrow		BRincrease\
	blink		TextButton	registerButton\
	blink		TextButton	matchButton\
	blink		TextToggle	blinkButton\
\
	optionsBox	TextToggle	pannerButton\
	optionsBox	TextToggle	magnifierButton\
	optionsBox	TextToggle	coordsBoxButton\
	optionsBox	TextToggle	warningsButton\
	optionsBox	TextToggle	tileFramesButton\
	optionsBox	TextToggle	autoTileButton\
	optionsBox	TextToggle	autoscaleButton\
	optionsBox	TextToggle	antialiasButton\
\
	controlBox	Layout		control\
	control		TextButton	initializeButton\
	control		TextButton	normalizeButton\
	control		TextButton	doneButton\
\
	toplevel	TransientShell	SAOtngWarning\
	SAOtngWarning	Layout		warn\
	warn		Frame		warnFrame\
	warnFrame	Layout		WFlayout\
	WFlayout	Icon		warnIcon\
	WFlayout	TextBox		warnText\
	warn		TextButton	warnOk\
	warn		TextButton	warnCancel\
\
	toplevel	TopLevelShell	SAOtngDialog\
	SAOtngDialog	Layout		dialog\
	dialog		Icon		dialogIcon\
	dialog		TextBox		dialogLabel\
	dialog		Frame		dialogFrame\
	dialogFrame	AsciiText	dialogValue\
	dialog		TextButton	dialogOk\
	dialog		TextButton	dialogClear\
	dialog		TextButton	dialogCancel\
\
	toplevel	TopLevelShell	SAOtngHelp\
	SAOtngHelp	Layout		helpLay\
	helpLay		Label		helpLabel\
	helpLay		Frame		helpFrame\
	helpFrame	HTML		helpText\
	helpLay		Label		nexturlLabel\
	helpLay		TextButton	helpReset\
	helpLay		TextButton	helpBack\
	helpLay		TextButton	helpForw\
	helpLay		TextButton	helpDone\
\
	toplevel	TopLevelShell	SAOtngMessages\
	SAOtngMessages	Layout		messLay\
	messLay		Label		messLabel\
	messLay		Frame		messFrame\
	messFrame	AsciiText	messLine\
	messLay		TextButton	messClear\
	messLay		TextButton	messDone\
\
	toplevel	Parameter	saotng\
	saotng		Parameter	acclist\
	saotng		Parameter	accolors\
	saotng		Parameter	anallist\
	saotng		Parameter	antialias\
	saotng		Parameter	autoscale\
	saotng		Parameter	autoconfig\
	saotng		Parameter	autoflip\
	saotng		Parameter	blocklist\
	saotng		Parameter	coords\
	saotng		Parameter	cmaps\
	saotng		Parameter	cmapparams\
	saotng		Parameter	colortables\
	saotng		Parameter	curcolor\
	saotng		Parameter	curpan\
	saotng		Parameter	curroi\
	saotng		Parameter	curscale\
	saotng		Parameter	cursorMode\
	saotng		Parameter	deleteFrame\
	saotng		Parameter	enhancement\
	saotng		Parameter	fixmarkers\
	saotng		Parameter	help\
	saotng		Parameter	imagetitle\
	saotng		Parameter	initcmds\
	saotng		Parameter	initialize\
	saotng		Parameter	invert\
	saotng		Parameter	frame\
	saotng		Parameter	framelist\
	saotng		Parameter	frameEvent\
	saotng		Parameter	frameRegion\
	saotng		Parameter	frameSize\
	saotng		Parameter	frameTitle\
	saotng		Parameter	frameView\
	saotng		Parameter	manallist\
	saotng		Parameter	maxsize\
	saotng		Parameter	nframes\
	saotng		Parameter	openxpa\
	saotng		Parameter	printer\
	saotng		Parameter	regions\
	saotng		Parameter	regionnames\
	saotng		Parameter	resize\
	saotng		Parameter	scalelist\
	saotng		Parameter	scalesamples\
	saotng		Parameter	selectpos\
	saotng		Parameter	statusline\
	saotng		Parameter	tcl\
	saotng		Parameter	tileFrames\
	saotng		Parameter	trackcoords\
	saotng		Parameter	xflip\
	saotng		Parameter	yflip

!DO NOT DELETE

    *beNiceToColormap:				False
    *Label*shadowWidth:				2

    *allowShellResize:				true
    *iconName:					#IT
    *topForm.defaultDistance:			0
    *topForm.top:				chainTop
    *topForm.bottom:				chainTop
    *topForm.left:				chainLeft
    *topForm.right:				chainRight
    *topForm.background:			#BG
    *topForm.mappedWhenManaged:			False

    *menuForm.imageButton.width:		88
    *menuForm.imageLabel.width:			90

    *menuForm.top:				chainTop
    *menuForm.bottom:				chainTop
    *menuForm.left:				chainLeft
    *menuForm.right:				chainRight
    *menuForm.background:			#BG
    *menuForm.foreground:			#MF
    *menuForm.borderWidth:			0
    *menuForm*highlightThickness:		1
    *menuForm*shadowScheme:			Color
    *menuForm*topShadowColor:			whitesmoke

    *menuForm*TextButton.height:		30
    *menuForm*TextButton.width:			72
    *menuForm*TextButton.borderWidth:		0
    *menuForm*TextButton.borderColor:		black
    *menuForm*TextButton.foreground:		#MF
    *menuForm*TextButton.background:		#MB
    *menuForm*TextButton.frameWidth:		1
    *menuForm*TextButton.font:			#F1

    *menuForm*Label.justify:			center
    *menuForm*Label.width:			72
    *menuForm*Label.borderWidth:		0
    *menuForm*Label.background:			#BG
    *menuForm*Label.foreground:			black
    *menuForm*Label.font:			#F1

    *imageButton.label:				Images
    *imageButton.translations: \
	Any<Btn1Down>: popup(fileMenu) \n\
	  Any<Btn1Up>: popdown(fileMenu)
    *imageLabel.label:				*
    *imageLabel.fromVert:			imageButton

    *frameButton.label:				Frames
    *frameButton.translations: \
	Any<Btn1Down>: popup(frameMenu) \n\
	  Any<Btn1Up>: popdown(frameMenu)
    *frameButton.fromHoriz:			imageButton
    *frameLabel.label:				*       
    *frameLabel.fromVert:			frameButton
    *frameLabel.fromHoriz:			imageLabel

    *colorButton.label:				Colors
    *colorButton.translations: \
	Any<Btn1Down>: popup(colorMenu) \n\
	  Any<Btn1Up>: popdown(colorMenu)
    *colorButton.fromHoriz:			frameButton
    *colorLabel.label:				*     
    *colorLabel.fromVert:			colorButton
    *colorLabel.fromHoriz:			frameLabel

    *markerButton.label:			Markers
    *markerButton.translations: \
	Any<Btn1Down>: popup(cursorMenu) \n\
	  Any<Btn1Up>: popdown(cursorMenu)
    *markerButton.fromHoriz:			colorButton
    *markerLabel.label:				*
    *markerLabel.fromVert:			markerButton
    *markerLabel.fromHoriz:			colorLabel

    *zoomButton.label:				Zoom
    *zoomButton.translations: \
	Any<Btn1Down>: popup(panMenu) \n\
	  Any<Btn1Up>: popdown(panMenu)
    *zoomButton.fromHoriz:			markerButton
    *zoomLabel.label:				*
    *zoomLabel.fromVert:			zoomButton
    *zoomLabel.fromHoriz:			markerLabel

    *scaleButton.label:				Scales
    *scaleButton.translations: \
	Any<Btn1Down>: popup(scaleMenu) \n\
	  Any<Btn1Up>: popdown(scaleMenu)
    *scaleButton.fromHoriz:			zoomButton
    *scaleLabel.label:				*  
    *scaleLabel.fromVert:			scaleButton
    *scaleLabel.fromHoriz:			zoomLabel

    *coordsButton.label:			Coords
    *coordsButton.translations: \
	Any<Btn1Down>: popup(wcsMenu) \n\
	  Any<Btn1Up>: popdown(wcsMenu)
    *coordsButton.fromHoriz:			scaleButton
    *coordsLabel.label:				*
    *coordsLabel.fromVert:			coordsButton
    *coordsLabel.fromHoriz:			scaleLabel

    *analButton.label:				Analysis
    *analButton.menuName:			analMenu
    *analButton.translations: \
	Any<Btn1Down>: popup(analMenu) \n\
	  Any<Btn1Up>: popdown(analMenu)
    *analButton.fromHoriz:			coordsButton
    *analButton.sensitive:			False
    *analLabel.label:				*  
    *analLabel.fromVert:			analButton
    *analLabel.fromHoriz:			coordsLabel

    *aV.fromVert:				menuForm
    *aV*background:				#BG
    *aV*vertical*background:			#BG
    *aV*vertical*foreground:			black
    *aV*horizontal*background:			#BG
    *aV*horizontal*foreground:			black
    *aV.width:					120
    *aV.allowHoriz:				True
    *aV.allowVert:				True
    *aV.borderWidth:				0
    *aV.mappedWhenManaged:			False

    *aF*top:					chainTop
    *aF*bottom:					chainTop
    *aF*left:					chainLeft
    *aF*right:					chainRight
    *aF*background:				#BG
    *aF*foreground:				black
    *aF.borderWidth:				0
    *aF*highlightThickness:			1
    *aF*font:					#F2

    *aF*TextButton.height:			25
    *aF*TextButton.width:			90
    *aF*TextButton.borderWidth:			0
    *aF*TextButton.borderColor:			black
    *aF*TextButton.foreground:			black
    *aF*TextButton.background:			#BG
    *aF*TextButton.frameWidth:			1

    *aB1.label:					B1
    *aB2.label:					B2
    *aB2.fromVert:				aB1
    *aB3.label:					B3
    *aB3.fromVert:				aB2
    *aB4.label:					B4
    *aB4.fromVert:				aB3
    *aB5.label:					B5
    *aB5.fromVert:				aB4
    *aB6.label:					B6
    *aB6.fromVert:				aB5
    *aB7.label:					B7
    *aB7.fromVert:				aB6
    *aB8.label:					B8
    *aB8.fromVert:				aB7
    *aB9.label:					B9
    *aB9.fromVert:				aB8
    *aB10.label:				B10
    *aB10.fromVert:				aB9
    *aB11.label:				B11
    *aB11.fromVert:				aB10
    *aB12.label:				B12
    *aB12.fromVert:				aB11
    *aB13.label:				B13
    *aB13.fromVert:				aB12
    *aB14.label:				B14
    *aB14.fromVert:				aB13
    *aB15.label:				B15
    *aB15.fromVert:				aB14
    *aB16.label:				B16
    *aB16.fromVert:				aB15
    *aB17.label:				B17
    *aB17.fromVert:				aB16
    *aB18.label:				B18
    *aB18.fromVert:				aB17
    *aB19.label:				B19
    *aB19.fromVert:				aB18
    *aB20.label:				B20
    *aB20.fromVert:				aB19
    *aB21.label:				B21
    *aB21.fromVert:				aB20
    *aB22.label:				B22
    *aB22.fromVert:				aB21
    *aB23.label:				B23
    *aB23.fromVert:				aB22
    *aB24.label:				B24
    *aB24.fromVert:				aB23
    *aB25.label:				B25
    *aB25.fromVert:				aB24

    *imageForm.background:			#BG
    *imageForm.foreground:			black
    *imageForm*borderWidth:			0
    *imageForm.defaultDistance:			0
    *imageForm.fromVert:			menuForm
    *imageForm.fromHoriz:			aV

    *cmapName:					default[20,#IT]
!   *Gterm.cmapName:				#IT
    *Gterm.basePixel:				64
    *imagewin.warpCursor:			true
    *imagewin.raiseWindow:			true
    *imagewin.deiconifyWindow:			true
    *imagewin.ginmodeCursor:			circle
    *imagewin.ginmodeBlinkInterval:		500
    *imagewin.resizable:			true
    *imagewin.copyOnResize:			false
    *imagewin.width:				512
    *imagewin.height:				512
    *imagewin.color8:				#BG
    *imagewin.color9:				#MB

    *imagewin.translations: 					\
	 <Key>Return:  graphics-input() call(sendCoords,$x,$y)	\n\
	   #KT<Key>a:  call(dispPatch,$x,$y)			\n\
	   #KT<Key>b:  call(PrevFrame,$name)			\n\
	   #KT<Key>c:  call(dispCoords,$x,$y)			\n\
	   #KT<Key>f:  call(NextFrame,$name)			\n\
	   #KT<Key>i:  call(IdleCursor)				\n\
	   #KT<Key>t:  call(CreateTextMarker,"?",$x,$y)		\n\
	   #KT<Key>x:  call(SelectImage,$x,$y)			\n\
	   #KT<Key>u:  call(UnselectImage)			\n\
       !Shift <Key>c:  call(toggleTrack)			\n\
       !Shift <Key>m:  call(toggleMagnifier)			\n\
       !Shift <Key>p:  call(togglePanner)			\n\
       !Shift <Key>x:  call(SelectImage $x $y) call(RedisplayImage) \n\
  ~Shift<Key>#KPLeft:  call(TranslateCursor,$x,$y,-1,0) 	\n\
 ~Shift<Key>#KPRight:  call(TranslateCursor,$x,$y,1,0) 		\n\
    ~Shift<Key>#KPUp:  call(TranslateCursor,$x,$y,0,-1) 	\n\
  ~Shift<Key>#KPDown:  call(TranslateCursor,$x,$y,0,1) 		\n\
  !Shift<Key>#KPLeft:  call(TranslateCursor,$x,$y,-5,0) 	\n\
 !Shift<Key>#KPRight:  call(TranslateCursor,$x,$y,5,0) 		\n\
    !Shift<Key>#KPUp:  call(TranslateCursor,$x,$y,0,-5) 	\n\
  !Shift<Key>#KPDown:  call(TranslateCursor,$x,$y,0,5) 		\n\
    ~Shift<Btn1Down>:  call(makeMarker,$name,$x,$y) m_create() \n\
    !Shift<Btn1Down>:  call(ImageSelectProc,$x,$y,$time) 	\n\
    !Shift<Btn2Down>:  crosshair(on)				\n\
  !Shift<Btn2Motion>:  crosshair(on) track-cursor() call(Track,$x,$y) \n\
	    <Btn2Up>:  crosshair(off)				\n\
	  <Btn2Down>:  call(Zoom,$x,$y)				\n\
          <Btn3Down>:  call(windowColormap,$x,$y)		\n\
        <Btn3Motion>:  call(windowColormap,$x,$y)		\n\
       <EnterWindow>:  enter-window()				\n\
       <LeaveWindow>:  leave-window()				\n\
          <KeyPress>:  graphics-input()				\n\
       !Ctrl<Motion>:  						\n\
            <Motion>:  track-cursor() call(Track,$x,$y)

    *colorbar.translations: \
       Any<Btn1Down>:  call(noop)				\n\
       Any<Btn3Down>:  popup(scaleMarkerMenu,$x,$y)		\n\
         Any<Btn3Up>:  popdown(scaleMarkerMenu)

    *colorbar.maxRasters:			1
    *colorbar.maxMappings:			1
    *colorbar.fromVert:				imagewin
    *colorbar.vertDistance:			2
    *colorbar.top:				chainBottom
    *colorbar.bottom:				chainBottom
    *colorbar.width:				512
    *colorbar.height:				18

    *helpButton.fromVert:			aV
    *helpButton.width:				110
    *helpButton.height:				30
    *helpButton.font:				#F2
    *helpButton.label:				Help
    *helpButton.foreground:	              	#CF
    *helpButton.background:			#BG
    *helpButton.horizDistance:			5
    *helpButton.vertDistance:			30
    *helpButton.frameWidth:			1
	
    *infoForm.background:			#BG
    *infoForm.foreground:			black
    *infoForm*borderWidth:			0
    *infoForm.defaultDistance:			0
    *infoForm.fromVert:                         imageForm
    *infoForm.fromHoriz:			aV

    *scaleSamples.displayCaret:			False
    *scaleSamples.width:			512
    *scaleSamples.height:			20
    *scaleSamples*background:			#BG
    *scaleSamples*foreground:			black
    *scaleSamples*font:				#F2
    *scaleSamples.top:				chainBottom
    *scaleSamples.bottom:			chainBottom

    *imageTitle.fromVert:			scaleSamples
    *imageTitle.vertDistance:			0
    *imageTitle.displayCaret:			False
    *imageTitle.width:				495
    *imageTitle.height:				65
    *imageTitle*background:			#BG
    *imageTitle*foreground:			black
    *imageTitle*font:				#F2
    *imageTitle.top:				chainBottom
    *imageTitle.bottom:				chainBottom

    *ok.label:					OK
    *ok.background:				#CB
    *ok.font:					#F2
    *ok.borderColor:				black
    *ok.borderWidth:				1
    *ok*highlightThickness:			1

    *cancel.background:				#CB
    *cancel.font:				#F2
    *cancel.label:				Cancel
    *cancel.borderColor:			black
    *cancel.borderWidth:			1
    *cancel*highlightThickness:			1

    *clear.background:				#CB
    *clear.font:				#F2
    *clear.label:				Clear
    *clear.borderColor:				black
    *clear.borderWidth:				1
    *clear*highlightThickness:			1

    ! Main Control Panel.
    ! ------------------------------
    *controlShell.title:			#IT Control Panel
    *controlShell.iconName:			#IT
    *controlPanel*Group.font:			#F1
    *controlPanel*background:			#BG
    *controlPanel*foreground:			#CF
    *controlPanel*TextBox.background:		#BG
    *controlPanel*internalWidth:		0
    *controlPanel*borderWidth:			0
    *controlPanel*Command.background:		#CB
    *controlPanel*Command.highlightThickness:	1
    *controlPanel*Command.borderWidth:		1
    *controlPanel*Toggle.background:		#BG
    *controlPanel*Toggle.highlightThickness:	1
    *controlPanel*Toggle.borderWidth:		1
    *controlPanel*Toggle.frameWidth:		1
    *controlPanel*Toggle.width:			40
    *controlPanel*Toggle.height:		30
    *controlPanel*Toggle.font:			#F2
    *controlPanel*TextButton.frameWidth:	1
    *controlPanel*TextButton.width:		40
    *controlPanel*TextButton.height:		30

    *TextBox.font:				#F5
    *TextToggle.font:				#F3
    *Command.font:				#F3
    *TextButton.font:				#F3
    *Toggle.font:				#F3
    *MultiList.font:				#F3
    *Label.font:				#F4
    *zoomLayout*Command.font:			#F5
    *blinkFrame1.font:				#F5
    *blinkFrame2.font:				#F5
    *blinkFrame3.font:				#F5
    *blinkFrame4.font:				#F5

    *controlPanel.debug:			False
    *controlPanel.layout: vertical { \
	5 < -5 > \
	horizontal { \
	    -1 \
	    viewBox < +inf -inf * > \
	    -1 \
	} \
	5 < -5 > \
	horizontal { \
	    -1 \
	    enhancementBox < +inf -inf * +inf -inf > \
	    -1 \
	    vertical { \
		-1 \
		blinkBox < * +inf - inf > \
		-1 \
		optionsBox < * +inff -inff > \
		-1 \
	    } \
	    -1 \
	} \
	5 < -5 > \
	horizontal { \
	    -1 \
	    wcsBox < +inf -inf * > \
	    -1 \
	} \
	5 < -5 > \
	controlBox < +inf * > \
    }

    ! VIEW
    ! ------------------
    *viewBox.label:				View
    *viewBox.location:				0 0 450 0
    *viewBox.shrinkToFit:			True
    *viewBox.outerOffset:			7

    *view.debug:				False
    *view.layout: vertical { \
	5 < +inf -5 > \
	horizontal { \
	    -1 \
	    frameSelect \
	    -1 \
	    vertical { \
		5 < -5 > \
		frameDataBox < +inff -100% * +inff -100% > \
		5 < -5 > \
	    } \
	    -1 \
	    zoomBox \
	    -1 \
	} \
	1 < +inf > \
	viewButtons < +inf -inf * +inf -inf > \
	5 < +inf -5 > \
    }

    *frameDataBox.frameType:			sunken
    *frameDataBox.frameWidth:			1
    *frameData.width:				130
    *frameData.height:				50

    *frameSelect.location:			0 0 72 0
    *frameSelect.shrinkToFit:			True
    *frameSelect.outerOffset:			7
    *frameSelect.innerOffset:			5
    *frameSelect.frameWidth:			2
    *frameSelect*offIcon:			diamond0s
    *frameSelect*onIcon:			diamond1s
    *frameSelect*highlightColor:		black
    *frameSelect.label:				Frame

    *frameBox.debug:				False
    *frameBox.layout: vertical { \
	frame1 < +inf * > \
	frame2 < +inf * > \
	frame3 < +inf * > \
	frame4 < +inf * > \
	10 < +inf -10 > \
	horizontal { \
	    -1 \
	    prevFrame \
	    10 < +inf -5 > \
	    nextFrame \
	    -1 \
	} \
	-1 \
    }

    *frameBox*location:				0 0 10 20
    *frameBox*alignment:			left
    *frameBox*frameWidth:			0
    *frameBox*highlightThickness:		0
    *frameBox*frame1.label:			\ 1\ \ 
    *frameBox*frame2.label:			\ 2\ \ 
    *frameBox*frame3.label:			\ 3\ \ 
    *frameBox*frame4.label:			\ 4\ \ 
    *frameBox*Command.width:			24
    *frameBox*prevFrame.label:			xx
    *frameBox*nextFrame.label:			xx

    *zoomBox.label:				Zoom
    *zoomBox.location:				0 0 160 127
    *zoomBox.outerOffset:			7
    *zoomBox.shrinkToFit:			True

    *zoomLayout.debug:				False
    *controlPanel*zoom*internalWidth:		4
    *zoomLayout.layout: vertical { \
	space = ((50% of width zoomLayout) - (50% of width z5)) \
	1 < +inf > \
	horizontal { \
	    vertical { \
		toggleZoom < +inf * +inf > \
		2 \
	    } \
	    2 \
	    vertical { \
		2 < +inf > \
		z5 \
		1 < +inf > \
		z3 \
		0 < +inf > \
	    } \
	    2 \
	    vertical { \
		zoomIn < +inf * +inf > \
		2 \
	    } \
	} \
	1 < +inf > \
	horizontal { \
	    2 < +inf > \
	    d8 d4 d2 x1 z2 z4 z8 \
	    2 < +inf > \
	} \
	1 < +inf > \
	horizontal { \
	    vertical { \
		2 \
		zoomOut < +inf * +inf > \
	    } \
	    2 \
	    vertical { \
		0 < +inf > \
		d3 \
		1 < +inf > \
		d5 \
		2 < +inf > \
	    } \
	    2 \
	    vertical { \
		2 \
		centerFrame < +inf * +inf > \
	    } \
	} \
	1 < +inf > \
    }

    *toggleZoom.label:				Toggle\nZoom
    *toggleZoom.outerOffset:			0
    *toggleZoom.width:				30
    *toggleZoom.height:				25

    *zoomIn.label:				Zoom\nIn
    *zoomIn.outerOffset:			0
    *zoomIn.width:				30
    *zoomIn.height:				25

    *x1.label:					1
    *z2.label:					2
    *z3.label:					3
    *z4.label:					4
    *z5.label:					5
    *z8.label:					8

    *controlPanel*zoomIn.foreground:		#CF
    *controlPanel*z4.foreground:		white
    *controlPanel*z5.foreground:		white
    *controlPanel*z8.foreground:		white
    *controlPanel*z2.foreground:		white
    *controlPanel*z3.foreground:		white

    *zoomOut.label:				Zoom\nOut
    *zoomOut.outerOffset:			0
    *zoomOut.width:				30
    *zoomOut.height:				25

    *centerFrame.label:				Center
    *centerFrame.outerOffset:			0
    *centerFrame.width:				30
    *centerFrame.height:			25

    *d2.label:					2
    *d3.label:					3
    *d4.label:					4
    *d5.label:					5
    *d8.label:					8

    *controlPanel*zoomOut.foreground:		#CF
    *controlPanel*d2.foreground:		#CF
    *controlPanel*d3.foreground:		#CF
    *controlPanel*d4.foreground:		#CF
    *controlPanel*d5.foreground:		#CF
    *controlPanel*d8.foreground:		#CF

    *viewButtons.location:			0 0 100 80
    *viewButtons.debug:				False
    *viewButtons.layout: horizontal { \
	5 < -2 > \
	aspect < +inf * > \
	5 < -2 > \
	flipX < +inf * > \
	5 < -2 > \
	flipY < +inf * > \
	5 < -2 > \
	flipXY < +inf * > \
	5 < -2 > \
	clearframe < +inf * > \
	5 < -2 > \
	fitframe < +inf * > \
	5 < -2 > \
    }

    *nextFrame.label:				Next Frame
    *prevFrame.label:				Previous Frame
    *fitframe.label:				Fit
    *fitframe.borderColor:			black
    *aspect.label:				Aspect
    *aspect.borderColor:			black
    *clearframe.label:				Clear
    *clearframe.borderColor:			black
    *flipX.label:				Flip X
    *flipX.borderColor:				black
    *flipY.label:				Flip Y
    *flipY.borderColor:				black
    *flipXY.label:				Flip XY
    *flipXY.borderColor:			black


    ! WCS
    ! ----------------------
    *wcsBox.label:				WCS
    *wcsBox.location:				0 0 110 0
    *wcsBox.shrinkToFit:			True
    *wcsBox.frameType:				chiseled
    *wcsBox.frameWidth:				2
    *wcsBox.outerOffset:			7
    *wcsBox.innerOffset:			5
    *wcsBox.height:				20
    *wcsBox*alignment:				left

    *wcstext*displayCaret:			False
    *wcstext*height:				20
    *wcstext*width				120
    *wcstext*font:				#F5

    ! ENHANCEMENT
    ! ------------------
    *enhancementBox.label:			Colors
    *enhancementBox.location:			0 0 110 0
    *enhancementBox.shrinkToFit:		True
    *enhancementBox.outerOffset:		7

    *enhance.debug:				False
    *enhance.layout: vertical { \
	3 < -3 > \
	horizontal { \
	    2 < -2 > \
	    colorlistScroll < * +inff -inff > \
	    -1 \
	    colorlistFrame < +inf -inf * +inff -inff > \
	    2 < -2 > \
	} \
	-1 \
	horizontal { \
	    2 < -2 > \
	    colordataFrame < +inf -inf * +inf -inf > \
	    2 < -2 > \
	} \
	5 < -5 > \
	horizontal { \
	    2 < -2 > \
	    vertical { \
		-1 \
		contrastLabel \
		3 < -3 > \
		brightnessLabel \
		3 < -3 > \
		maxcontrastLabel \
		-1 \
	    } \
	    3 < -3 > \
	    vertical { \
		-1 \
		contrastSlider < +inf -inf * > \
		3 < -3 > \
		brightnessSlider < +inf -inf * > \
		3 < -3 > \
		maxcontrastSlider < +inf -inf * > \
		-1 \
	    } \
	    2 < -2 > \
	} \
	5 < -5 > \
	horizontal { \
	    5 < -5 > \
	    invertButton < +inf * > \
	    60 < +inf -100% > \
	} \
	3 < -3 > \
    }

    *colordataLayout.debug:  				False
    *colordataLayout.layout: vertical { \
	2 \
	colordata < +inf -100% * > \
	1 \
	colordata2 < +inf -100% * > \
	2 \
    }

    *enhance*FrameType:				sunken
    *enhance*FrameWidth:			1
    *enhance*BorderWidth:			0
    *enhance*Label.ShadowWidth:			0
    *enhance*thumbColor:			#CF
    *enhance*colordata.frameWidth:		0
    *enhance*colordata2.frameWidth:		0
    *enhance.TextToggle.location:		0 0 102 25
    *enhance.TextToggle.frameWidth:		0

    *colorlistScroll.location:			0 0 20 10
    *colorlistScroll.vertical:			True
    *colorlistScroll*minsize:			10
    *colorlist.width:				100
    *colorlist.height:				88
    *colordata.height:				22
    *colordata.width:				120
    *colordata2.height:				34
    *colordata2.width:				120
    *contrastLabel.label:			x
    *contrastSlider.location:			0 0 100 20
    *maxcontrastLabel.label:			x
    *maxcontrastSlider.location:		0 0 100 20
    *brightnessLabel.label:			x
    *brightnessSlider.location:			0 0 100 20
    *invertButton.label:			Invert Colormap

    ! BLINK
    ! ---------------------
    *blinkBox.label:				Blink
    *blinkBox.location:				0 0 230 0
    *blinkBox.shrinkToFit:			True
    *blinkBox.outerOffset:			7


    *blink.debug:				False
    *blink.layout: vertical { \
	space = (width blinkFramesLabel - width blinkRateLabel) \
	3 < -3 > \
	horizontal { \
	    0 \
	    blinkFramesLabel \
	    3 < +inf > \
	    blinkFrame1 < -50% * > \
	    blinkFrame2 < -50% * > \
	    blinkFrame3 < -50% * > \
	    blinkFrame4 < -50% * > \
	    4 < +inf > \
	    blinkReset \
	    2 \
	} \
	5 < -5 > \
	horizontal { \
	    $space \
	    blinkRateLabel \
	    2  \
	    BRframe < +inf * > \
	} \
	5 < +inf -100% > \
	horizontal { \
	    3 \
	    registerButton < +inf * > \
	    5 < -5 > \
	    matchButton < +inf * > \
	    2 \
	} \
	horizontal { \
	    5 < -5 > \
	    blinkButton < +inf * > \
	    120 < +inf -100% > \
	} \
	3 < -3 > \
    }

    *BRlayout.layout: horizontal { \
	BRdecrease \
	BRtext < +inf -100% * > \
	BRincrease \
    }

    *blink.Label.borderWidth:			0
    *blink.Label.shadowWidth:			0
    *controlPanel*blink*internalWidth:		4
    *controlPanel*blink*Arrow.background:	#CB
    *controlPanel*blink*Arrow.foreground:	#CF
    *blink*Arrow.width:				16
    *blink*Arrow.height:			25
    *blink.TextToggle.location:			0 0 102 25
    *blink.TextToggle.frameWidth:		0

    *blinkFramesLabel.label:			Frames:
    *blinkFrame1.label:				1
    *blinkFrame2.label:				2
    *blinkFrame3.label:				3
    *blinkFrame4.label:				4
    *blinkReset.width:				30
    *blinkReset.label:				Reset
    *blinkReset.borderColor:			black

    *blinkRateLabel.label:			Rate:
    *BRframe.frameType:				sunken
    *BRframe.frameWidth:			1
    *BRtext.width:				40
    *BRtext.height:				20
    *BRdecrease.direction:			left
    *BRincrease.direction:			right
    *registerButton.sensitive:			#ER
    *registerButton.label:			Register
    *registerButton.borderColor:		black
    *matchButton.sensitive:			#ER
    *matchButton.label:				Match
    *matchButton.borderColor:			black
    *blinkButton.label:				Blink Frames

    ! OPTIONS
    ! ---------------------
    *optionsBox.label:				Options
    *optionsBox.location:			0 0 240 0
    *optionsBox.shrinkToFit:			False
    *optionsBox.outerOffset:			7
    *optionsBox*offIcon:			square0s
    *optionsBox*onIcon:				square1s
    *optionsBox*selectionStyle:			multi
    *optionsBox*highlightColor:			#CF
    *optionsBox.TextToggle.location:		0 0 102 25
    *optionsBox.TextToggle.frameWidth:		0
    *optionsBox*alignment:			left

    *pannerButton.label:			Panner
    *coordsBoxButton.label:			Screen Coords
    *autoscaleButton.label:			Autoscale
    *antialiasButton.label:			Antialias
    *tileFramesButton.label:			Tile Frames
    *autoTileButton.label:			Auto Switching
    *warningsButton.label:			Warnings
    *magnifierButton.label:			Magnifier

    ! CONTROL
    ! ----------------------
    *controlBox.frameType:			chiseled
    *controlBox.frameWidth:			2
    *controlBox.outerOffset:			7
    *controlBox.innerOffset:			5
    *controlBox.height:				30

    *control.debug:  False
    *control.layout: horizontal { \
	1 \
	initializeButton < +inf * > \
	5 < -5 > \
	normalizeButton < +inf * > \
	80 < +inf -100% > \
	doneButton < +inf * > \
	1 \
    }

    *initializeButton.label:			Initialize
    *initializeButton.borderColor:		black
    *normalizeButton.label:			Normalize
    *normalizeButton.borderColor:		black
    *doneButton.label:				Close
    *doneButton.borderColor:			black

    ! SAOtng WARNING dialog.
    ! ---------------------
    *SAOtngWarning.title:			#IT Warning
    *SAOtngWarning*background:			#BG
    *SAOtngWarning*borderWidth:			0
    *SAOtngWarning*TextBox.frameWidth:		0
    *SAOtngWarning*TextBox.font:		#F1
    *SAOtngWarning*TextButton.frameWidth:	1
    *SAOtngWarning*TextButton.width:		40
    *SAOtngWarning*TextButton.height:		30
    *SAOtngWarning*TextButton.font:		#F2

    *warn.layout: vertical { \
	5 < -5 > \
	horizontal { \
	    5 < -5 > \
	    warnFrame < +inf * +inf > \
	    5 < -5 > \
	} \
	1 < -1 > \
	horizontal { \
	    5 < -5 > \
	    warnOk < +inf * > \
	    50 < +inf -100% > \
	    warnCancel < +inf * > \
	    5 < +inf -5 > \
	} \
	1 < -1 > \
    }

    *WFlayout.layout: horizontal { \
	5 < -5 > \
	vertical { \
	    5 < +inf -5 > \
	    warnIcon \
	    5 < +inf -5 > \
	} \
	5 < -5 > \
	warnText < +inf -inf * +inf -inf > \
	5 < -5 > \
    }

    *warnLabel.label:				Warning
    *warnLabel.width:				3000
    *warnLabel.height:				20
    *warnFrame.frameType:			sunken
    *warnFrame.frameWidth:			1
    *warnIcon.location:				0 0 40 40
    *warnIcon.image:				WARNING
    *warnText.label:				generic warning text
    *warnText.width:				325
    *warnText.height:				60
    *warnOk.label:				OK
    *warnCancel.label:				Cancel

    ! SAOtng Dialog Box
    ! ---------------------
    *SAOtngDialog.title:			#IT Dialog
    *SAOtngDialog.iconName:			#IT
    *SAOtngDialog.background:			#BG
    *SAOtngDialog*foreground:			black
    *SAOtngDialog*borderWidth:			0
    *SAOtngDialog*Text.translations:  #override \n\
	       Ctrl<Key>c : call(cancelDialog)	\n\
	   Ctrl<Key>Delete: delete-selection()	\n\
 	       <Key>Return: call(okDialog)
    *SAOtngDialog*Layout.background:		#BG
    *SAOtngDialog*Frame.background:		#BG
    *SAOtngDialog*TextBox.frameWidth:		0
    *SAOtngDialog*TextBox.font:			#F1
    *SAOtngDialog*TextBox.background:		#BG
    *SAOtngDialog*Icon.background:		#BG
    *SAOtngDialog*TextButton.frameWidth:	1
    *SAOtngDialog*TextButton.width:		40
    *SAOtngDialog*TextButton.height:		30
    *SAOtngDialog*TextButton.font:		#F2
    *SAOtngDialog*TextButton.background:	#BG

    *dialog.debug:				False
    *dialog.layout: vertical { \
	1 < -1 > \
	horizontal { \
	    5 < -5 > \
	    dialogIcon \
	    5 < +inf -5 > \
	    dialogLabel < +inf -inf * +inf -inf > \
	    5 < -5 > \
	} \
        5 < -5 > \
        dialogFrame < +inf -inf * +inf -inf > \
        5 < -5 > \
	horizontal { \
	    5 < -5 > \
	    dialogOk < +inf * > \
	    5 < -5 > \
	    dialogClear < +inf * > \
	    50 < +inf -100% > \
	    dialogCancel < +inf * > \
	    5 < +inf -5 > \
	} \
	1 < -1 > \
    }

    *dialogFrame.frameType:			sunken
    *dialogFrame.frameWidth:			1
    *dialogIcon.location:			0 0 40 40
    *dialogIcon.image:				QUESTION
    *dialogLabel.label:				generic dialoging text
    *dialogLabel.width:				325
    *dialogValue.width:				300
    *dialogValue.height:			32
    *dialogValue.resize:			width
    *dialogValue.leftMargin:			6
    *dialogValue.topMargin:			6
    *dialogValue.bottomMargin:			2
    *dialogValue*font:				#F6
    *dialogValue*background:			#DC
    *dialogValue*editType:			edit
    *dialogOk.label:				OK
    *dialogCancel.label:			Cancel
    *dialogClear.label:				Clear

    ! HTML help resources.
    ! ------------------------------

    *SAOtngHelp.title:				#IT Help
    *SAOtngHelp*Label.font:			#F1
    *SAOtngHelp*HTML*background:		white
    *SAOtngHelp*background:			#BG
    *SAOtngHelp*foreground:			black
    *SAOtngHelp.iconName:			#IT
    *SAOtngHelp*borderWidth:			0
    *SAOtngHelp*translations:	#override	\n\
	    Ctrl<Key>c: call(cancelHelp)	\n\
	   <Key>Return: call(okHelp)
    *SAOtngHelp*TextButton.frameWidth:		1
    *SAOtngHelp*TextButton.width:		40
    *SAOtngHelp*TextButton.height:		30
    *SAOtngHelp*TextButton.font:		#F2

    *helpLay.debug:				False
    *helpLay.layout: vertical { \
	1 < -1 > \
	helpLabel < +inf -inf * +inf -inf > \
        5 < -5 > \
        helpFrame < +inf -inf * +inf -inf > \
        5 < -5 > \
	nexturlLabel < +inf -inf * +inf -inf > \
        5 < -5 > \
	horizontal { \
	    5 < -5 > \
	    helpReset < +inf * > \
	    5 < -5 > \
	    helpBack < +inf * > \
	    5 < -5 > \
	    helpForw < +inf * > \
	    60 < +inf -100% > \
	    helpDone < +inf * > \
	    5 < +inf -5 > \
	} \
	1 < -1 > \
    }

    *helpFrame.frameType:			sunken
    *helpFrame.frameWidth:			1
    *helpLabel.label:				generic helping text
    *helpLabel.width:				325

    *helpText*background:			white
    *helpText*foreground:			#CF
    *helpText.width:				500
    *helpText.height:				450
    *helpText.anchorUnderlines:			1
    *helpText.anchorColor:			#0000EE
    *helpText.visitedAnchorColor:		#551A8B
    *helpText.activeAnchorFG:			#FF0000
    *helpText.activeAnchorBG:			white
    *helpText.visitedAnchorUnderlines:		1
    *helpText.dashedVisitedAnchorUnderlines:	true
    *helpText.HTML*borderWidth:			1

    *helpReset.label:				Home
    *helpBack.label:				Prev
    *helpForw.label:				Next
    *helpDone.label:				Close

    ! SAOtng Messages
    ! ----------------------
    *SAOtngMessages.title:			#IT Messages
    *SAOtngMessages.iconName:			#IT
    *SAOtngMessages*foreground:			black
    *SAOtngMessages*AsciiText*background:	white
    *SAOtngMessages*Layout.background:		#BG
    *SAOtngMessages*Frame.background:		#BG
    *SAOtngMessages*Label.background:		#BG
    *SAOtngMessages*Label.font:			#F1
    *SAOtngMessages*TextButton.background:	#BG
    *SAOtngMessages*borderWidth:		0
    *SAOtngMessages*TextBox.frameWidth:		0
    *SAOtngMessages*TextBox.font:		#F1
    *SAOtngMessages*TextButton.frameWidth:	1
    *SAOtngMessages*TextButton.width:		40
    *SAOtngMessages*TextButton.height:		30
    *SAOtngMessages*TextButton.font:		#F2

    *messLay.debug:				False
    *messLay.layout: vertical { \
	1 < -1 > \
	messLabel < +inf * > \
        5 < -5 > \
        messFrame < +inf -inf * +inf -inf > \
        5 < -5 > \
    	horizontal { \
	    10 < +inf -100% > \
	    messClear < +inf * > \
	    360 < +inf -100% > \
	    messDone < +inf * > \
	    10 < +inf -100% > \
	} \
	1 < -1 > \
    }

    *messLabel.label:				#IT Messages
    *messLabel.height:				30
    *messLabel.width:				550
    *messFrame.frameType:			sunken
    *messFrame.frameWidth:			1
    *messLine.displayCaret:			False
    *messLine.height:				150
    *messLine.width:				740
    *messLine.wrap:				line
    *messLine.scrollVertical:			whenNeeded
    *messLine*font:				#F6
    *messClear*label:				Clear
    *messClear*highlightThickness:		1
    *messDone*label:				Close
    *messDone*highlightThickness:		1

    ! more or less Global defaults
    ! ------------------------------
    *SimpleMenu.borderWidth:			1
    *SimpleMenu*background:			#BG
    *SimpleMenu*foreground:			black
    *SimpleMenu*borderColor:			black
    *SimpleMenu*font:				#F1
    *foreground:				black

    ! GUI resources.
    ! ------------------------------
    *autoscale:					True
    *zoomfactors:				1 2 4 8
    *displayCoords:				True
    *displayPanner:				#PN
    *blinkRate:					1.0
    *pannerArea:				150*150
    *pannerGeom:				-5+5
    *wcsboxGeom:				-5-5
    *maxContrast:				5.0
    *warnings:					False
    *winHeight:					512	
    *winWidth:					512	

! These should match the values in Gterm.c  We have to add them here
! because they are defined to be of class XtCBackground and XtCForeground,
! which are specified on Alphas via xrdb as "*background" and "*foreground",
! resulting in assignment of a single color to all of them. Blah!
! Same holds true for fonts ... (using XtCFont) ...
! NB: the colors must match the associative colors array below
    SAOtng.color0:		black
    SAOtng.color1:		white
    SAOtng.color2:		red
    SAOtng.color3:		green
    SAOtng.color4:		blue
    SAOtng.color5:		cyan
    SAOtng.color6:		yellow
    SAOtng.color7:		magenta
    SAOtng.color8:		purple
    SAOtng.color9:		darkslategray
    SAOtng.alphaFont1:	nil2
    SAOtng.alphaFont2:	5x8
    SAOtng.alphaFont3:	6x10
    SAOtng.alphaFont4:	7x13
    SAOtng.alphaFont5:	8x13
    SAOtng.alphaFont6:	9x15
    SAOtng.alphaFont7:	7x13bold
    SAOtng.alphaFont8:	9x15bold
    SAOtng.markerTextFont:	6x13
}

# #############################################################################
#
# The resource string has in it a lot of macro definitions for colors.
# We have to query the environment to determine which color values these
# macros need to be expanded to -- this is the gui "Flavor".
#
# #############################################################################

# Utility procedure to test True/False strings in resources.
proc true { v } {expr {$v == "true" || $v == "True" || $v == "TRUE"}}
proc false { v } {expr {$v == "false" || $v == "False" || $v == "FALSE"}}

# must be initi'ed before SAOtngFlavor ...
set MenuFont   "-adobe-times-bold-r-normal--14-140-75-75-p-77-iso8859-1"
set CommandFont "-adobe-times-medium-r-normal--14-140-75-75-p-74-iso8859-1"
set SmallFont1 "-adobe-times-medium-r-normal--12-120-75-75-p-64-iso8859-1"
set SmallFont2 "-adobe-times-bold-r-normal--12-120-75-75-p-67-iso8859-1"
set SmallFont3 "7x13bold"
set LargeFont1 "9x15"
set guiFlavor "DEFAULT"
set TextDisplay 1
set TextBkgd True
set DefaultColor "none"
set Restrict 1
set AnalFormat "submenu"
set DefaultMarker "circle"
set DisplayControlPanel "False"
set DisplayMessages "True"
set DisplayPanner "magnifier"
set EnableRegister true
set IconTitle "SAOtng"
set ImageFilter "*.fits *.fit *.imh *.qp"
set KeyboardPrefix ""
set KeyTrans "!Ctrl"
set MarkerWarning 0
set SaveRegCmd {$env(XPAGET) $xpa regions > $filename}
set SaveImageCmd {$env(XPAGET) $xpa file raw_data > $filename}
set LoadRegCmd {cat $filename | $env(XPASET) $xpa regions}
set RegionFilter "*.reg"
set Verbose 0
set MarkerFont 2
set RaisePanMag True

# set up the GUI flavor
# this has to be done before we make macro substitutions in the object list
proc SAOtngFlavor args {
    global env
    global Restrict
    global AnalFormat
    global MenuFont CommandFont
    global SmallFont1 SmallFont2 SmallFont3 LargeFont1
    global BackgroundColor DialogColor
    global CommandBackground CommandForeground
    global DefaultMarker
    global DisplayControlPanel
    global DisplayMessages
    global DisplayPanner
    global guiFlavor
    global EnableRegister
    global TextDisplay
    global TextBkgd
    global DefaultColor
    global IconTitle
    global ImageDir
    global ImageFilter
    global KeyboardPrefix
    global KeyTrans
    global LoadRegCmd
    global MarkerWarning
    global MarkerFont
    global MenuBackground MenuForeground
    global RegionDir
    global RegionFilter
    global RaisePanMag
    global SaveImageCmd
    global SaveRegCmd
    global Verbose
   
    # this environment variable must be defined ...
    if { [info exists env(SAORD_GUIFLAVOR)] } {
	set guiFlavor [string toupper $env(SAORD_GUIFLAVOR)]
    } else {
	set env(SAORD_GUIFLAVOR) $guiFlavor
    }

    # set defaults based on the gui flavor
    if { $guiFlavor == "BEAUTIFUL"}  {
	set BackgroundColor "lightgoldenrodyellow"
	set DialogColor "#D3B5B5"
	set CommandBackground "#B2B2B2"
	set CommandForeground "black"
	set MenuBackground "darkslateblue"
	set MenuForeground "lightgoldenrodyellow"
    } elseif { $guiFlavor == "BLAND"}  {
	set BackgroundColor "white"
	set DialogColor "white"
	set CommandBackground "white"
	set CommandForeground "black"
	set MenuBackground "white"
	set MenuForeground "black"
    } else {
	set BackgroundColor "#C0C0C0"
	set DialogColor "#D3B5B5"
	set CommandBackground "#B2B2B2"
	set CommandForeground "black"
	set MenuBackground "#C0C0C0"
	set MenuForeground "black"
    }

    # now override the defaults based on environment variables
    if { [info exists env(SAOTNG_BACKGROUNDCOLOR)] } {
	set BackgroundColor $env(SAOTNG_BACKGROUNDCOLOR)
    }
    if { [info exists env(SAOTNG_COMMANDBACKGROUND)] } {
	set CommandBackground $env(SAOTNG_COMMANDBACKGROUND)
    }
    if { [info exists env(SAOTNG_COMMANDFOREGROUND)] } {
	set CommandForeground $env(SAOTNG_COMMANDFOREGROUND)
    }
    if { [info exists env(SAOTNG_DIALOGCOLOR)] } {
	set BackgroundColor $env(SAOTNG_DIALOGCOLOR)
    }
    if { [info exists env(SAOTNG_LARGEFONT1)] } {
	set LargeFont1 $env(SAOTNG_LARGEFONT1)
    }
    if { [info exists env(SAOTNG_MENUBACKGROUND)] } {
	set MenuBackground $env(SAOTNG_MENUBACKGROUND)
    }
    if { [info exists env(SAOTNG_MENUFOREGROUND)] } {
	set MenuForeground $env(SAOTNG_MENUFOREGROUND)
    }
    if { [info exists env(SAOTNG_MENUFONT)] } {
	set MenuFont $env(SAOTNG_MENUFONT)
    }
    if { [info exists env(SAOTNG_COMMANDFONT)] } {
	set CommandFont $env(SAOTNG_COMMANDFONT)
    }
    if { [info exists env(SAOTNG_SMALLFONT1)] } {
	set SmallFont1 $env(SAOTNG_SMALLFONT1)
    }
    if { [info exists env(SAOTNG_SMALLFONT2)] } {
	set SmallFont2 $env(SAOTNG_SMALLFONT2)
    }
    if { [info exists env(SAOTNG_SMALLFONT3)] } {
	set SmallFont3 $env(SAOTNG_SMALLFONT3)
    }

    # set other variables ...
    if { [info exists env(SAOTNG_ANALFORMAT)] } {
	set AnalFormat $env(SAOTNG_ANALFORMAT)
    }
    if { [info exists env(SAOTNG_RESTRICT)] } {
	set Restrict [true $env(SAOTNG_RESTRICT)]
    }
    if { [info exists env(SAOTNG_CONTROLPANEL)] } {
	set DisplayControlPanel $env(SAOTNG_CONTROLPANEL)
    }
    if { [info exists env(SAOTNG_IMGDIR)] } {
	set ImageDir $env(SAOTNG_IMGDIR)
    }
    if { [info exists env(SAOTNG_IMGFILTER)] } {
	set ImageFilter $env(SAOTNG_IMGFILTER)
    }
    if { [info exists env(SAOTNG_KBPREFIX)] } {
	set KeyboardPrefix $env(SAOTNG_KBPREFIX)
    }
    if { [info exists env(SAOTNG_LOADREGIONS)] } {
	set LoadRegCmd $env(SAOTNG_LOADREGIONS)
    }
    if { [info exists env(SAOTNG_MARKER)] } {
	set DefaultMarker $env(SAOTNG_MARKER)
    }
    if { [info exists env(SAOTNG_MARKERWARNING)] } {
	set MarkerWarning [true $env(SAOTNG_MARKERWARNING)]
    }
    if { [info exists env(SAOTNG_MARKERFONT)] } {
	set MarkerFont $env(SAOTNG_MARKERFONT)
    }
    if { [info exists env(SAOTNG_MESSAGES)] } {
	set DisplayMessages $env(SAOTNG_MESSAGES)
    }
    if { [info exists env(SAOTNG_PANMAG)] } {
	set DisplayPanner $env(SAOTNG_PANMAG)
    }
    if { [info exists env(SAOTNG_REGDIR)] } {
	set RegionDir $env(SAOTNG_REGDIR)
    }
    if { [info exists env(SAOTNG_REGFILTER)] } {
	set RegionFilter $env(SAOTNG_REGFILTER)
    }
    if { [info exists env(SAOTNG_RAISEPANMAG)] } {
	set RaisePanMag $env(SAOTNG_RAISEPANMAG)
    }
    if { [info exists env(SAOTNG_SAVEREGIONS)] } {
	set SaveRegCmd $env(SAOTNG_SAVEREGIONS)
    }
    if { [info exists env(SAOTNG_SAVEIMAGE)] } {
	set SaveImageCmd $env(SAOTNG_SAVEIMAGE)
    }
    if { [info exists env(SAOTNG_TITLE)] } {
	set IconTitle $env(SAOTNG_TITLE)
    }
    if { [info exists env(SAOTNG_TRANSPREFIX)] } {
	set KeyTrans $env(SAOTNG_TRANSPREFIX)
    }
    if { [info exists env(SAOTNG_VERBOSE)] } {
	set Verbose [true $env(SAOTNG_VERBOSE)]
    }
    if { [info exists env(SAOTNG_TEXTDISPLAY)] } {
	set TextDisplay [true $env(SAOTNG_TEXTDISPLAY)]
    }
    if { [info exists env(SAOTNG_TEXTBKGD)] } {
	set TextBkgd [true $env(SAOTNG_TEXTBKGD)]
    }
    if { [info exists env(SAOTNG_DEFAULTCOLOR)] } {
	set DefaultColor $env(SAOTNG_DEFAULTCOLOR)
    }
    if { [info exists env(SAOTNG_ENABLEREGISTER)] } {
	set EnableRegister $env(SAOTNG_ENABLEREGISTER)
    }
}
SAOtngFlavor

# #############################################################################
#
# Now we replace all of the macro variables with real values
#
# #############################################################################

regsub -all #BG $SAOtngResources  $BackgroundColor SAOtngResources
regsub -all #DC $SAOtngResources  $DialogColor SAOtngResources
regsub -all #MB $SAOtngResources  $MenuBackground SAOtngResources
regsub -all #MF $SAOtngResources  $MenuForeground SAOtngResources
regsub -all #CB $SAOtngResources  $CommandBackground SAOtngResources
regsub -all #CF $SAOtngResources  $CommandForeground SAOtngResources
regsub -all #KP $SAOtngResources  $KeyboardPrefix SAOtngResources
regsub -all #KT $SAOtngResources  $KeyTrans SAOtngResources
regsub -all #IT $SAOtngResources  $IconTitle SAOtngResources
regsub -all #PN $SAOtngResources  $DisplayPanner SAOtngResources
regsub -all #F1 $SAOtngResources  $MenuFont SAOtngResources
regsub -all #F2 $SAOtngResources  $CommandFont SAOtngResources
regsub -all #F3 $SAOtngResources  $SmallFont1 SAOtngResources
regsub -all #F4 $SAOtngResources  $SmallFont2 SAOtngResources
regsub -all #F5 $SAOtngResources  $SmallFont3 SAOtngResources
regsub -all #F6 $SAOtngResources  $LargeFont1 SAOtngResources
regsub -all #ER $SAOtngResources  $EnableRegister SAOtngResources


# #############################################################################
#
# Having real values, we init the GUI with a fully populated resource string
#
# #############################################################################

appInitialize saotng SAOtng $SAOtngResources

# #############################################################################
#
# Now that the widgets are defined, create them and start up the GUI ...
# But don't manage the widgets (i.e., put them on the screen) yet, we
# need to change the size of the window before we do that ...
#
# #############################################################################

createObjects
send colorbar setGterm
send imagewin setGterm

# Additional global variables, taking default values from resources.
getResources {
	{ autoscale }
	{ zoomfactors }
	{ displayCoords }
	{ displayPanner }
	{ blinkRate }
	{ pannerArea }
	{ pannerGeom }
	{ wcsboxGeom }
	{ maxContrast }
	{ warnings }
	{ winWidth }
	{ winHeight }
}

# #############################################################################
#
# Here we calculate the window size
#
# #############################################################################

# control if we adjust odd window sizes
set AdjustOddWindowSize 1

proc SetWindowSize { width height } \
{
    global winHeight
    global winWidth
    global fitAccelCmds
    global Restrict

    if { $Restrict } {
      if { [expr $height % 2] == 1 } {
	incr height -1
      }
      if { [expr $width % 2] == 1 } {
	incr width -1
      }
    }
    send imagewin set height $height
    send imagewin set width $width
    send colorbar set width $width
    send imageTitle set width $width
    set csize [send colorbar get height]
    set maxheight [expr $height + $csize]
    set bsize [send aV get borderWidth]
    # figure out a nice height for the accelView
    set cbsize [send aB1 get height]
    set cbborder [send aB1 get borderWidth]
    set cbspace [send aF get defaultDistance]
    set cbheight [expr $cbsize + $cbspace + $cbborder + $cbborder]
    # this gives an integral number of buttons in view
    set ncb [expr $maxheight / $cbheight]
    set dheight [expr $ncb * $cbheight + 10]
    send aV set height $dheight

    set fitAccelCmds $ncb
    set winWidth $width
    set winHeight $height
}
SetWindowSize $winWidth $winHeight

# #############################################################################
#
# Finally!
# Now that the size has been specified, we can map all windows ...
# 
#
# #############################################################################

activate
send topForm set mappedWhenManaged True

# #############################################################################
#
# Run-time initialization:
#
# Reset the labels on some menus, since we couldn't have null strings
# in the resource-specification part
#  
# Get the environment variable for XPA commands
#
# Open a channel to the shell, through which we can send XPA commands
#
# Get additional resources
#
# #############################################################################

set markers_saved_frame(1) 1

set warnings [true $warnings]
set defaultBlinkRate $blinkRate

# set debug 1
set debug 0

send coordsLabel set label "hms/dms"
send analLabel set label " "

set blinkFrames "1 2"		;# list of blink/tile frames

# Client state variables (UI parameter objects).  Certain of these parameters
# we mirror in Tcl variables here, updating the values with a callback when
# the parameter value changes.  Others require special callbacks.

set frame 1			;# current display frame
set nframes 0			;# number of frame buffers
set frames {1 2 3 4}		;# list of image frames

# set dont_panzoomCursors 0	;# set to true when frameRegion shows 
				 #  a change of frame
# set pi [expr acos(-1)]

foreach i $frames {
    set frameSX($i) 0		;# left edge of windowed region of raster
    set frameSY($i) 0		;# top edge of windowed region of raster
    set frameSNX($i) 0		;# width of windowed region of raster
    set frameSNY($i) 0		;# height of windowed region of raster

    set frameZoomX($i) 0	;# X zoom factor
    set frameZoomY($i) 0	;# Y zoom factor
    set frameCenterX($i) 0	;# X center of field
    set frameCenterY($i) 0	;# Y center of field
    set frameScaleX($i) 0	;# X scale factor
    set frameScaleY($i) 0	;# Y scale factor
    set enhancement($i) none	;# colortable enhancement
}

# create an associative array of valid marker colors
# these must match *color resources above
set colors(black)	0
set colors(white)	1
set colors(red)		2
set colors(green)	3
set colors(blue)	4
set colors(cyan)	5
set colors(yellow)	6
set colors(magenta)	7
set colors(purple)	8
set colors(darkslategray) 9

#
#  ExecuteTCL -- execute a TCL command sent from an external process
#
proc ExecuteTCL { param old new } {
    uplevel #0 $new
}; send tcl addCallback ExecuteTCL

# #############################################################################
#
#  Routine to send XPA commands to the image display client
#  Using SendXPA makes the GUI act just like any other external process
#
# #############################################################################

set xpa SAOtng				; # default XPA tareget name
set xpamode internal			; # use shell xpa or internal xpa call
set xpafd -1				; # fd for shell

#
# OpenShell -- open a shell for commands
#
proc OpenShell args {
    global xpafd env

    if { $xpafd == -1 } {
	set err [catch {set xpafd [open "|/bin/csh -f" r+]} ermsg ]
	if { $err != 0 } {
	    Print [format "Error: can't open shell: %s" $ermsg]
	    return
	}
    }
    puts $xpafd "setenv SAORD_GUIFLAVOR $env(SAORD_GUIFLAVOR)"
}

#
#  OpenXPA -- open a channel to the XPA access point
#
proc OpenXPA { param old new } {
    global xpa xpafd xpamode debug
    set xpa [lindex $new 0]
    set xpamode [lindex $new 1]
    if { $xpafd >= 0 } {
	close $xpafd
    }
    if { $xpamode != "internal" } {
	if { $xpamode == "shell" } {
	    set xpafd [open "|/bin/csh -f" r+]	
	} else {
	    set xpafd [open $xpamode r+]
	}
    }
    if { $debug } {
	print [format "Setting '%s' to use '%s' xpa call " $xpa $xpamode]
    }	
}; send openxpa addCallback OpenXPA
 
#
# SendXPA -- send a command using the XPA facility
#
proc SendXPA {cmd {param ""}} \
{
    global xpa xpafd xpamode env
    global debug

    if { $debug } {
	print [format "sending XPA command: %s %s" $cmd $param]
    }

    if { $xpamode != "internal" } {
	OpenShell
	if { $xpafd == -1 } {
	    return
	}
	puts $xpafd "echo '$cmd' | $env(XPASET) -w $xpa $param"
	flush $xpafd
    } else {
	send client xpaset $xpa [list $cmd $param]
    }
}

#
#  InitialCommands -- process an initial list of xpa commands
#			each time we create a frame
#
set initcmds ""
proc SetInitialCommands { param old new } {
    global initcmds
    set initcmds $new
    # make sure we do this for frame 1 ...
    InitialCommands
}; send initcmds addCallback SetInitialCommands 

proc InitialCommands { args } {
    global initcmds
    # execute the init commands when a new frame is created
    set list [split [lindex $initcmds 0] ";"]
    set len [llength $list]
    if { $len > 0 } {
	for {set i 0} {$i < $len} {incr i} {
	    set cmd [lindex $list $i]
	    if { $cmd != "" } {
		SendXPA "$cmd"
	    }
	}
    }
}

# #############################################################################
#
# XPA callbacks for keyboard translations (no other place to put 'em)
#
# #############################################################################

proc NextFrame args		{ SetFrame "next" }
proc PrevFrame args		{ SetFrame "prev" }

#
# Initialize bitmaps.
#
createBitmap larrow 16 16 {
   0x00, 0x00, 0x00, 0x03, 0x80, 0x03, 0xc0, 0x03, 0xe0, 0x1e, 0x70, 0x1e,
   0x38, 0x18, 0x1c, 0x18, 0x1c, 0x18, 0x38, 0x18, 0x70, 0x1e, 0xe0, 0x1e,
   0xc0, 0x03, 0x80, 0x03, 0x00, 0x03, 0x00, 0x00};

createBitmap rarrow 16 16 {
   0x00, 0x00, 0xc0, 0x00, 0xc0, 0x01, 0xc0, 0x03, 0x78, 0x07, 0x78, 0x0e,
   0x18, 0x1c, 0x18, 0x38, 0x18, 0x38, 0x18, 0x1c, 0x78, 0x0e, 0x78, 0x07,
   0xc0, 0x03, 0xc0, 0x01, 0xc0, 0x00, 0x00, 0x00};

createBitmap brightness 15 15 {
   0x00, 0x00, 0x80, 0x00, 0x84, 0x10, 0xe8, 0x0b, 0x10, 0x04, 0x08, 0x08,
   0x08, 0x08, 0x0e, 0x38, 0x08, 0x08, 0x08, 0x08, 0x10, 0x04, 0xe8, 0x0b,
   0x84, 0x10, 0x80, 0x00, 0x00, 0x00};

createBitmap contrast 15 15 {
   0x00, 0x00, 0x00, 0x00, 0xc0, 0x01, 0x30, 0x07, 0x08, 0x0f, 0x08, 0x0f,
   0x04, 0x1f, 0x04, 0x1f, 0x04, 0x1f, 0x08, 0x0f, 0x08, 0x0f, 0x30, 0x07,
   0xc0, 0x01, 0x00, 0x00, 0x00, 0x00};

createBitmap maxcontrast 16 16 {
   0x80, 0x00, 0x70, 0x07, 0x08, 0x08, 0x04, 0x10, 0x22, 0x22, 0x62, 0x23,
   0xa2, 0x22, 0xa1, 0x42, 0x22, 0x22, 0x22, 0x22, 0x22, 0x22, 0x04, 0x10,
   0x08, 0x08, 0x70, 0x07, 0x80, 0x00, 0x00, 0x00};

# #############################################################################
#
# MARKER stuff.  The active marker is determined by the global variable
# "marker", which is the marker the pointer is in, or which the pointer
# was most recently in.
#
# #############################################################################

# NB: these must match the definition in obm/marker.c
set FixType		000001
set FixPosition		000002
set FixSize		000004
set FixRotation		000010
set FixPoints		000020
set FixDelete		000040
set FixZoom		000100
set FixZoomSize		000200

proc GetFixParams { m params } {
    global FixType FixPosition FixSize FixRotation FixPoints FixDelete 
    global FixZoom FixZoomSize
    upvar 1 $params oparams
    send $m getAttributes fix fix
    set oparams ""
    if { $fix & $FixType } {
	append oparams "type "
    }    
    if { $fix & $FixPosition } {
	append oparams "position "
    }    
    if { $fix & $FixSize } {
	append oparams "size "
    }    
    if { $fix & $FixRotation } {
	append oparams "rotation "
    }    
    if { $fix & $FixPoints } {
	append oparams "points "
    }    
    if { $fix & $FixDelete } {
	append oparams "delete "
    }    
    if { $fix & $FixZoom } {
	append oparams "zoom "
    }    
    if { $fix & $FixZoomSize } {
	append oparams "zoomsize "
    }    
    if { $oparams == "" } {
	set oparams "none "
    }
    set oparams [string trim $oparams]
}

proc DisplayFixParams { { which "cur" }  } {
    global marker
    global MarkerFixParams

    if { $which == "global" } {
        Print [format "Global Marker Fix Params:\t%s" $MarkerFixParams]
    } else {
	if { $which == "cur" } {
	    set which $marker
	}
	GetFixParams $which params    
        Print [format "This Marker's Fix Params:\t%s" $params]
    }
    MessDisplay
}

# current fix/free parameter state
set MarkerFixParams "none"

#
# FixMarkers -- called when there is a change to the fix params,
# for current markers, new markers, or both
#
proc FixMarkers { param old new } {
	global MarkerFixParams

	switch [lindex $new 0] {
	    cur {
		ParseFixParams [lrange $new 1 end] mparams
		FixMlist $mparams
	    }
	    new {
		ParseFixParams [lrange $new 1 end] mparams
		set MarkerFixParams $mparams
	    }
	    all {
		if { [llength $new] == 1 } {
		    set MarkerFixParams all
		} else {
		    ParseFixParams [lrange $new 1 end] mparams
		    FixMlist $mparams
		    set MarkerFixParams $mparams
		}
	    }
	    default {
		ParseFixParams [lrange $new 0 end] mparams
		set MarkerFixParams $mparams
	    }
	}
}; send fixmarkers addCallback FixMarkers

#
# ParseFixParams -- parse the fix params string and set up defaults, etc.
#
proc ParseFixParams { s params } {
	global MarkerFixParams
	upvar 1 $params mparams

	set mparams $s
	if { $mparams == "cur" } {
	    set mparams $MarkerFixParams
	}
        regsub -all "," $mparams  " " mparams
}

#
# SetFixParams -- send comment to Gterm to fix marker param state
#
proc SetFixParams { {params "?"} } {
    global marker
    global MarkerFixParams
    if { $params == "?" } {
	set params $MarkerFixParams
    }
    regsub -all "," $params  " " params
    send $marker fix $params
}

#
# NewFixParams -- pop up dialog to load new fix parameters
#
set newParams ""		;# last value returned from this dialog
proc NewFixParams args {
    global newParams
    global MarkerFixParams

    set newParams $MarkerFixParams
    set cmd [format "set MarkerFixParams \$newParams"]
    startDialog "Enter fix params (e.g. +pos -size): " \
		"$cmd" "$newParams" "newParams" "xeq" }

#
# NewFixParams2 -- pop up dialog to load new fix parameters for current marker
#
set newParams2 ""		;# last value returned from this dialog
proc NewFixParams2 args {
    global marker
    global newParams2
    global MarkerFixParams

    GetFixParams $marker newParams2
    if { $newParams2 != "none" } {
        set newParams2 "none $newParams2"
    }
    set cmd [format "SetFixParams \$newParams2"]
    startDialog "Enter fix params (e.g. +pos -size): " \
		"$cmd" "$newParams2" "newParams2" "xeq"
}

#
# UpSaM -- UPdate Saved Marker status
#
proc UpSaM { {count "false"} } { 
    global markers_saved_frame frame

    if { [true $count] } {
        CountMlist got
    } else {
	set got 1
    }
    if { $got == 0 } {
        set markers_saved_frame($frame) 1
    } else {
        set markers_saved_frame($frame) 0
    }
}

set markerTranslations { \
	  <Btn1Down>:  m_raise() m_markposAdd()
 	    <Btn1Up>:  m_redraw() m_destroyNull() call(NullM,$name,$x,$y) call(VuM) call(UpSaM) track-cursor()
 !Shift <Btn1Motion>:  m_rotateResize() call(Track,$x,$y) call(UpSaM)
	<Btn1Motion>:  m_moveResize() call(Track,$x,$y) call(UpSaM)
	<Btn2Motion>:  m_move() call(Track,$x,$y) call(UpSaM)
	  <Btn2Down>:  track-cursor() m_raise()
	    <Btn2Up>:  m_redraw() m_destroyNull() call(NullM,$name,$x,$y) call(VuM) call(UpSaM) track-cursor()
	 Any<Btn3Up>:  popdown(markerMenu) 
       Any<Btn3Down>:  popup(markerMenu,$x,$y)
   Any<Key>BackSpace:  call(set,xm,$marker) call(SavM) m_deleteDestroyPorM() call(DelMlist,$xm) call(UpSaM,true)
      Any<Key>Delete:  call(set,xm,$marker) call(SavM) m_deleteDestroyPorM() call(DelMlist,$xm) call(UpSaM,true)
  ~Shift<Key>#KPLeft:  call(TransM,$x,$y,0,0,-1,0) call(VuM) call(UpSaM)
 ~Shift<Key>#KPRight:  call(TransM,$x,$y,0,0,1,0) call(VuM) call(UpSaM)
    ~Shift<Key>#KPUp:  call(TransM,$x,$y,0,0,0,-1) call(VuM) call(UpSaM)
  ~Shift<Key>#KPDown:  call(TransM,$x,$y,0,0,0,1) call(VuM) call(UpSaM)
  !Shift<Key>#KPLeft:  call(TransM,$x,$y,0,0,-5,0) call(VuM) call(UpSaM)
 !Shift<Key>#KPRight:  call(TransM,$x,$y,0,0,5,0) call(VuM) call(UpSaM)
    !Shift<Key>#KPUp:  call(TransM,$x,$y,0,0,0,-5) call(VuM) call(UpSaM)
  !Shift<Key>#KPDown:  call(TransM,$x,$y,0,0,0,5) call(VuM) call(UpSaM)
	   #KT<Key>+:  call(m_setIE,"+") call(UpSaM)
	   #KT<Key>-:  call(m_setIE,"-") call(UpSaM)
	   #KT<Key>a:  call(dispPatch,$x,$y)
	   #KT<Key>b:  call(m_setSource,"b") call(UpSaM)
	   #KT<Key>c:  call(dispCoords,$x,$y)
	   #KT<Key>e:  call(m_setIE,"-") call(UpSaM)
	   #KT<Key>i:  call(m_setIE,"+") call(UpSaM)
	   #KT<Key>l:  m_lower() call(UpSaM)
	   #KT<Key>r:  m_raise() call(UpSaM)
	   #KT<Key>s:  call(m_setSource,"s") call(UpSaM)
	   #KT<Key>u:  call(UnselectImage)
	   #KT<Key>x:  call(SelectImage,$x,$y)
	!Shift<Key>c:  call(toggleTrack)
	!Shift<Key>m:  call(toggleMagnifier)
	!Shift<Key>p:  call(togglePanner)
	!Shift<Key>x:  call(SelectImage $x $y) call(RedisplayImage)
	 <Key>Return:  graphics-input() call(sendCoords,$x,$y)
	  <KeyPress>:  m_input() graphics-input()
       !Ctrl<Motion>:  
	    <Motion>:  track-cursor() call(Track,$x,$y)
}
regsub -all #KP $markerTranslations  $KeyboardPrefix markerTranslations
regsub -all #KT $markerTranslations  $KeyTrans markerTranslations

#
# TEXTMARKER
#
proc EditMarkerMenu args {
	global marker
        global CurMAnalCmds
	
	set err [catch {send $marker "getAttributes fix fix"}]
	if { $err == 1 } {
	    set fix 0
	}
	set err [catch {send $marker "getAttributes markerTextDisplay disp"}]
	if { $err == 1 } {
	    set disp 1
	}

	set itemlist ""
	lappend itemList {"Marker Options" f.title}
	lappend itemList { f.dblline }
	lappend itemList { "Set Name (and Color) ..."	f.menu	markerType }
	lappend itemList { "Set Color ..."		f.menu	markerColor }
	lappend itemList { "Set Shape ..."		f.menu	markerShape }
	lappend itemList { "Set Include/Exclude ..."	f.menu	markerIE }
	lappend itemList { "Attach/Edit Text"	   f.exec  myGetMarkerText }
	if { $disp } {
	    lappend itemList { "Hide Text Display"  f.exec  ToggleTextDisplay }
	} else {
	    lappend itemList { "Show Text Display"  f.exec  ToggleTextDisplay }
	}
	lappend itemList { f.line }
	lappend itemList { "Display This Marker's Fix Params"	\
				f.exec  DisplayFixParams  sensitive $fix}
	lappend itemList { "Edit This Marker's Fix Params"  \
						f.exec  NewFixParams2 }
	lappend itemList { "Fix This Marker Using Global Fix Params"  \
						f.exec  ToggleFixed }
	lappend itemList { "Free Marker"	f.exec  ToggleFixed  sensitive $fix}
	lappend itemList { f.line }
	lappend itemList \
	{ "Zoom Within Marker" f.exec { zoomMarker $marker equal } }
	if { $CurMAnalCmds >0 } {
	    set flag 1
 	} else {
	    set flag 0
	}
	lappend itemList { "Print Marker" f.exec { VuM $marker true} }
	lappend itemList \
	" \"Marker Analysis Tasks ...\"	f.menu markerAnalMenu sensitive $flag"
	lappend itemList { f.line }
	lappend itemList { Destroy f.exec { DeleteMarker $marker } }
    editMenu markerMenu toplevel $itemList
    ReBland  markerMenu
}

createMenu markerColor toplevel {
    {	"Set Marker's Color"		f.title			}
    {			f.dblline		}
    {	Black		f.exec "m_setColor black"	}
    {	White		f.exec "m_setColor white"	}
    {	Red		f.exec "m_setColor red"		}
    {	Green		f.exec "m_setColor green"	}
    {	Blue		f.exec "m_setColor blue"	}
    {	Cyan		f.exec "m_setColor cyan"	}
    {	Yellow		f.exec "m_setColor yellow"	}
    {	Magenta		f.exec "m_setColor magenta"	}
}

createMenu markerShape toplevel {
    {	"Set Marker's Shape"		f.title			}
    {			f.dblline		}
    {	Circle		f.exec "m_setShape circle"	}
    {	Ellipse		f.exec "m_setShape ellipse"	}
    {	Line		f.exec "m_setShape line" 	}
    {	Point		f.exec "m_setShape point" 	}
    {	Polygon		f.exec "m_setShape polygon" 	}
    {	Rectangle	f.exec "m_setShape rectangle"	}
}


createMenu markerIE toplevel {
    {	"Set Marker's Include/Exclude"	f.title			}
    {			f.dblline		}
    {	Include		f.exec "m_setIE +"	} 
    {	Exclude		f.exec "m_setIE -"	} 
}


proc makeTypeMenu args {
    global nrname rnames rcolors

    set typeMenuDescription ""
    lappend typeMenuDescription \
    " \"Set This Marker's Type and Color\"	f.title"
    lappend typeMenuDescription \
    " 						f.dblline"
    for {set i 0} {$i < $nrname} {incr i} {
        lappend typeMenuDescription \
	" \{$rnames($i) ($rcolors($i))\} f.exec \{ 
#		m_setRName $rnames($i)
		m_setColor $rcolors($i) \}"
    }
    return $typeMenuDescription
}

# Callback executed when a marker gets or loses the focus.
proc selectMarker { active_marker event event_data } \
{
	global marker
	switch $event {
	    focusIn	{ 
		set marker $active_marker
		EditMarkerMenu
		EditTextMarkerMenu
		EditMarkerAnalMenu
	    }
	    focusOut	{ }
	}
}

# translate a marker
proc TransM { ix iy w l h v } \
{
    global marker

    if { $marker == "none" } return

    # get current size and position
    set err [catch {send $marker "getAttributes precisex x precisey y precisewidth width preciseheight height"} ]
    # jump out on error
    if { $err == 1 } return
    # calculate new size and position
    set width [expr $width + $w]
    set height [expr $height + $l]
    set x [expr $x + $h]
    set y [expr $y + $v]
    # set new cursor
    send $marker "\
	markpos; \
	setAttributes x $x y $y width $width height $height; \
	redraw; raise"
    TranslateCursor $x $y $h $v
}

set makingMarker 0

# Create marker action.  Makes a new marker.
proc makeMarker { parent x y } \
{
	global marker markerTranslations markno mtype frame
	global makingMarker
	global nrname rnames rcolors
	global DefaultColor

	# add this marker to the list
	set marker marker$markno;  incr markno

	set defname $DefaultColor
	for {set i 0} {$i < $nrname} {incr i} {
	    if { $DefaultColor == $rcolors($i) } {
		set defname $rnames($i)
		break
	    }
	}
	AddMlist $marker $frame "+" $defname $DefaultColor

	# flag that we are making a marker
	# this is needed by NullM
	set makingMarker 1

	# create the marker
	send $parent createMarker $marker \
	    type		$mtype \
	    createMode		interactive \
	    translations	$markerTranslations \
	    x			$x \
	    y			$y

	send $marker addCallback selectMarker focusIn focusOut
	m_setColor $DefaultColor $marker
}


# #############################################################################
#
# Routines to change the characteristics of a given marker
#
# #############################################################################

proc m_setShape { shape  {m "DEFAULT"} }  {
    global marker env
    if { $m == "DEFAULT" } {
	set m $marker
    }
    if { [info exists env(SAOTNG_KNOTSIZE)] } {
	send $m "markpos; \
	set type $shape; set knotsize $env(SAOTNG_KNOTSIZE) ; \
	redraw"
    } else {
	send $m "markpos; \
	set type $shape; \
	redraw"
    }
}

proc m_setColor { color  { m "DEFAULT"}}  {
    global marker
    if { $m == "DEFAULT" } {
	set m $marker
    }
    send $m "markpos; \
	set textColor $color; \
	set lineColor $color;  set highlightColor $color; redraw"
    EditMList COLOR $color $m
}

proc m_setIE { ie  {m "DEFAULT"} }  {
    global marker
    if { $m == "DEFAULT" } {
	set m $marker
    }
    if { $ie == "-" } {
            send $m "markpos; setAttributes lineStyle 1; redraw"
    } elseif { $ie == "+" } {
	    send $m "markpos; setAttributes lineStyle 0; redraw"
    }
    EditMList IE $ie $m
}

proc m_setRName { rname  {m "DEFAULT"} }  {
    global marker
    if { $m == "DEFAULT" } {
	set m $marker
    }
    EditMList RNAME $rname $m
}

# for backwards compatibility with old source/background support
proc m_setSource { sb  {m "DEFAULT"} }  {
    global marker
    global nrname rnames rcolors

    if { $m == "DEFAULT" } {
	set m $marker
    }
    if { $sb == "s" } {
	for {set i 0} {$i < $nrname} {incr i} {
	    if { $rnames($i) == "source" } {
		m_setColor $rcolors($i)
		return
	    }
	}
    } elseif { $sb == "b" } {
	for {set i 0} {$i < $nrname} {incr i} {
	    if { $rnames($i) == "background" } {
		m_setColor $rcolors($i)
		return
	    }
	}
    }
}

# #############################################################################
#
# Routines to create a default size and type marker, when the user
# simply clicks once to create a marker without going through the
# trouble of rubber-banding the size of the marker.
#
#
# #############################################################################

#
#
# NullM -- sense that the marker created was of null size
# and create a marker of default size and type
# 
#
proc NullM { parent x y } \
{
	global mlist marker markno
	global makingMarker
	global MarkerFixParams

	if { $makingMarker == 0 } {
	    return
	} else {
	    set makingMarker 0
	}
	
	# if the last marker is non-existent, copy previous marker
	set region "none"
	set err [catch { set region [send $marker getPreciseRegion] }]
	if { $err == 1 } {
	    incr markno -1
	    CopyLastMarker $parent $x $y
	} else {
	    set size [lindex $region 4]
	    if { $size == 0 } {
 		incr markno -1
 		CopyLastMarker $parent $x $y
	    }
	}

	# at this point we have create some sort of marker
	# set the fix/free state
	SetFixParams
}

set msize 20
#
# CopyLastMarker -- create a copy of the last created marker
# at the current location 
#
proc CopyLastMarker { parent x y } \
{
    global marker
    global mtype mlist msize
    global nrname rnames rcolors
    global DefaultColor

    CleanMlist
    set len [llength $mlist]
    set done 0
    while { ! $done } {
	if { $len != 0 } {
	    set markerlist [lindex $mlist [expr $len - 1]]
 	    set m [lindex $markerlist 0]
	    set ie [lindex $markerlist 2]
	    set rname [lindex $markerlist 3]
	    if { $m != "" } {
		set region [send $m getPreciseRegion]
		set type [lindex $region 0]
		# don't use text as last marker
		if { $type == "text" } {
		    incr len -1
		    continue
		}
		set width [lindex $region 4]
		if { $width == "" } { 
		    set width $msize
		}
		set height [lindex $region 5]
		if { $height == "" } {
		    set height $width
		}
		set rotangle [lindex $region 6]
		if { $rotangle == "" } {
		    set rotangle 0.0
		}
		if { $mtype == "circle" } {
		    set height $width
		}
		set err [catch {send $m "getAttributes text t"}]
		if { $err == 1 } {
		    set text ""
		} else {
		    set text "$t"
		}
		CreateMarker $ie $rname "" $mtype \
				$x $y $width $height $rotangle $text
		incr done
	    } else {
		CreateMarker $ie $DefaultColor "" \
					$mtype $x $y $msize $msize 0.0
		incr done
	    }
	} else {
	    CreateMarker "+" $DefaultColor "" \
					$mtype $x $y $msize $msize 0.0
	    incr done
	}
    }
}

#
# MapPixel -- map pixel from frame to screen coords
#
proc MapPixel {x y nx ny} {
    global frame
    global frameZoomX frameZoomY 
    global frameCenterX frameCenterY
    global frameScaleX frameScaleY
    global xflip yflip
    upvar 1 $nx ox
    upvar 1 $ny oy

    GetTiledWinSize winWidth winHeight sx sy

    set xzoom [expr double($frameZoomX($frame)) * $frameScaleX($frame)]
    set yzoom [expr double($frameZoomY($frame)) * $frameScaleY($frame)]

    set x_unmapped $x
    if { [expr int($winWidth/$xzoom)%2] == 1 } {
	set x_unmapped [expr $x_unmapped + 0.5]
    }
    set xu_offset [expr $x_unmapped  - double($frameCenterX($frame))]
    if {$xflip} {
        set xu_offset [expr -$xu_offset]
    }
    set x_mapped [expr (($xu_offset/($winWidth/$xzoom))+0.5)*$winWidth+$sx]

    set y_unmapped $y
    if { [expr int($winHeight/$yzoom)%2] == 1 } {
        set y_unmapped [expr $y_unmapped + 0.5]
    }
    set yu_offset [expr $y_unmapped  - double($frameCenterY($frame))]
    if {$yflip} {
        set yu_offset [expr -$yu_offset]
    }
    set y_mapped [expr (($yu_offset/($winHeight/$yzoom))+0.5)*$winHeight+$sy]

    set ox $x_mapped
    set oy $y_mapped
}

#
# CreateZoom1Marker -- make a marker where the input is in zoom1 coords
#
proc CreateZoom1Marker \
	{ie rname fix type com x y {width -1} {height -1} {rot 0.0}} \
{
    global frame frameZoomX frameZoomY
    global frameScaleX frameScaleY
    global marker
    global xflip yflip
 
    # change from frame to screen coords
    MapPixel $x $y nx ny

    # adjust size from frame (zoom 1) to current zoom
    set xzoom [expr double($frameZoomX($frame)) * $frameScaleX($frame)]
    set yzoom [expr double($frameZoomY($frame)) * $frameScaleY($frame)]
    set nw [expr $width  * $xzoom]
    set nh [expr $height * $yzoom]

    # flip the rotation angle
    if { ( $rot != 0.0 ) && ( $xflip != $yflip ) } {
	set rot [expr -$rot]
    }

    # create marker
    CreateMarker $ie $rname $fix $type $nx $ny $nw $nh $rot $com 0

    send $marker "setAttributes visible True"
}

#
# CreateZoom1Polygon -- make a polygon marker where the input is zoom1 coords
#
proc CreateZoom1Polygon {ie rname fix type com points} {
    global marker
 
    # create marker
    CreateMarker $ie $rname $fix $type 1 1 5 5 0 $com 0
 
    set pointlist [list [computePointList $points]]
    send $marker "setVertices $pointlist"

    send $marker "setAttributes visible True"
}

proc computePointList {points} \
{
    set num_points [llength $points]
    for {set i 0} {$i < $num_points} {incr i 2} {

	# get next point
        set x [lindex $points $i]
        set y [lindex $points [expr $i + 1]]
 
	# change from frame to screen coords
	MapPixel $x $y nx ny

	# these are the new points
        set npoints [lappend npoints $nx $ny]
    }
    return $npoints
}

#
# CreateZoom1Text -- make a text marker where the input is in zoom1 coords
#
proc CreateZoom1Text {ie rname fix type x y text} \
{
    global marker

    # change from frame to screen coords
    MapPixel $x $y nx ny

    GetTextDimensions "$text" theight twidth
    CreateMarker $ie $rname $fix $type $nx $ny $twidth $theight 0 $text 0

    send $marker "setAttributes visible True"
}

#
#
# CreateMarker -- make a marker of the given type at a given location 
#
proc CreateMarker {ie rname fix type x y width \
		   {height -1} {rotangle 0.0} {text ""} {draw 1}} {
        global marker markno frame
	global nrname rnames rcolors
	global markerTranslations textMarkerTranslations 
	global TextBkgd
	global TextDisplay
	global MarkerFixParams
	global colors
	global DefaultColor
	global MarkerFont

	if { $fix == "" } {
	    set fix $MarkerFixParams
	}
	if { $height <= 0 } {
	    set height $width
	}
	if { $rname == "" } {
#	    set rname $rnames(0)
#	    set color $rcolors(0)
	    set rname $DefaultColor
	    set color $DefaultColor
	} else {
	    set color $rname
	}
        for {set i 0} {$i < $nrname} {incr i} {
	    if { $rname == $rnames($i) } {
		set color $rcolors($i)
		break
	    } elseif { $rname == $rcolors($i) } {
		set rname $rnames($i)		
		break
	    }
	}
	# make sure color is legal
	if { [info exists colors($color)] == 0 } {
	    set color $DefaultColor
	}

        if { $ie == "+" } {
	    set linestyle 0
	} else {
            set linestyle 1
	}

	set marker marker$markno; incr markno
	AddMlist $marker $frame $ie $rname $color

	if { $draw } {
	    set visible True
	} else {
	    set visible False
	}

	set len [format "%sch" [string length $text]]	

	# create non-text marker
	if { $type != "text" } {

	    send imagewin createMarker $marker \
	    type		$type \
	    translations	$markerTranslations \
	    x			$x \
	    y			$y \
	    font		$MarkerFont \
	    textFont		$MarkerFont \
	    markerTextFont	$MarkerFont \
	    height		$height \
	    width		$width \
	    rotangle		$rotangle \
	    text		$text \
	    markerTextDisplay   $TextDisplay \
	    textWidth 		$len \
	    textHeight		1ch \
	    textColor 		$color \
	    lineColor		$color \
	    highlightColor	$color \
	    color		$color \
	    lineStyle		$linestyle \
            visible             $visible \
            activated           True \
            sensitive           True 

	# create text marker
	} else {

	    send imagewin createMarker $marker \
	    type		text \
	    text		$text \
	    translations	$textMarkerTranslations \
	    x			$x \
	    y			$y \
	    font		$MarkerFont \
	    textFont		$MarkerFont \
	    markerTextFont	$MarkerFont \
	    width		$width \
	    height		$height \
	    lineWidth		0 \
	    imageText		$TextBkgd \
	    textBgColor		black \
	    textColor		$color \
	    lineColor		$color \
	    highlightColor	$color \
	    visible		True \
            activated           True \
            sensitive           True

	}

	send $marker addCallback selectMarker focusIn focusOut

	# at this point we have create some sort of marker
	# set the fix/free state
	SetFixParams $fix
}

#
# DeleteMarker -- delete a marker (or all of them)
#
proc DeleteMarker { {which "cur"} } \
{
    global mlist markno marker frame
    global hold_region save_region
    global FixDelete

    if { $which == "cur" } {
	set which $marker
    }
    set ilist $mlist
    set n [llength $ilist]
    set olist ""
    for {set i 1} {$i <= $n} {incr i} {
	set markerlist [lindex $ilist [expr $i-1]]
	set curm [lindex $markerlist 0]
	set curf [lindex $markerlist 1]
	set curr [lindex $markerlist 3]
	# make sure we are in the right frame
	if { $frame != $curf } {
	    lappend olist $markerlist
	    continue
	}
	# at one point, we were losing markers ... so leave this in
	if { $curm == "" } {
	    continue
	}
	# look for the next marker by querying fix state
	set err [catch {send $curm "getAttributes fix fix"}]
	# if we found it ...
	if { $err == 0 } {
	    # delete all markers
	    if { $which == "all" } {
		send $curm setAttributes fix 0
		send $curm destroy
	    # only delete free regions
	    } elseif { $fix & $FixDelete } {
		lappend olist $markerlist
		continue
	    # delete marker by name
	    } elseif { $which == $curm } {
		SavM $which
		set err [catch {send $curm destroy}]
		if { $err == 0 } {
		    if { [info exists hold_region($frame)] } {
			set save_region($frame) $hold_region($frame)
			unset hold_region($frame)
		    }
		} else {
		    lappend olist $markerlist
		}
	    # delete marker by type
	    } elseif { $which == $curr } {
		set err [catch {send $curm destroy}]
		if { $err != 0 } {
		    lappend olist $markerlist
		}
	    # delete marker by pattern
	    } elseif { [string match $which $curr] } {
		set err [catch {send $curm destroy}]
		if { $err != 0 } {
		    lappend olist $markerlist
		}
	    } else {
		lappend olist $markerlist
	    }
	}
    }
    # this is the new mlist
    set mlist $olist
    # update the saved marker list
    UpSaM true
}

#
# SavM -- save a marker
#
proc SavM { {which "cur"} } {
    global frame marker hold_region
    if { $which == "cur" } {
	set which $marker
    }
    set s [SendRegion $frame $which "no" "NONE"]
    regsub "\n$" $s "" s
    if { $s != "" } {
        set hold_region($frame) $s
    }
}

#
# UndeleteMarker -- undelete last marker
#
proc UndeleteMarker { {which "cur"} } {
    global frame save_region
    if { [info exists save_region($frame)] } {
	Print [format "Restoring marker:\n%s" $save_region($frame)]
	SendXPA "regions '$save_region($frame)'"
	unset save_region($frame)
    } else {
	Print "No saved marker to restore!"
    }
}

#
# VuM -- view the position, size, etc. of the current marker
#
proc VuM { {which "cur"} {domess "false"} } {
    global frame marker

    if { $which == "cur" } {
	set which $marker
    }
#   SendRegions $frame $which "yes" "NONE"
#   use optimized code
    SendRegion $frame $which "yes" "NONE"
    if { [true $domess] } {
        MessDisplay
    }
    raisePanner
}

proc DeleteMarkerHelper {{force 0}} {
    global markers_saved_frame frame
    global warnings

    if { $force || !$warnings } {
	DeleteMarker all
    } else {
	Wexec {DeleteMarkerHelper 1} "Really delete all markers?"
    }
}

proc DeleteAllMarkers args {
    global markers_saved_frame frame
    global MarkerWarning

    if { $MarkerWarning } {
        if { ([info exists markers_saved_frame($frame)] == 0) } {
	    DeleteMarkerHelper
	} elseif {$markers_saved_frame($frame) == 0} {
	    Wexec {DeleteMarkerHelper 1} "Really delete all markers?"
	} else {
	    DeleteMarkerHelper
	}
    } else {
	DeleteMarkerHelper
    }
}

# #############################################################################
#
# Text markers -- labels for the image
#
# #############################################################################

set markertext ""		;# last value returned from this dialog
set marker_x  [expr $winWidth / 2]
set marker_y  [expr $winHeight / 2]

#
# GetMarkerText -- pop up dialog to get text for a new text marker
#
proc GetMarkerText args {
    global markertext
    startDialog "Enter a text string: " \
	"CreateTextMarker \$markertext" "$markertext" "markertext" "xeq"
}

proc AttachText { text marker } {
    GetTextDimensions "$text" height width
    send $marker "setAttributes height $height width $width text \"$text\""
    send $marker "redraw"
}

proc EditText args {
    global marker mymarkertext
    set err [catch {send $marker "getAttributes text t"}]
    if { $err == 1 } {
	set mymarkertext ""
    } else {
	set mymarkertext "$t"
    }
    startDialog "Edit the text string: " \
      "AttachText \$mymarkertext $marker" "$mymarkertext" "mymarkertext" "xeq"
}

proc ToggleImageText { { marker "" } } \
{
    global TextBkgd mlist

    set n [llength $mlist]
    if { $marker != "" } {
	set temp [send $marker get imageText]
	set temp [expr !$temp]
	if { $temp } {
	    send $marker "markpos; set imageText True; redraw"
	} else {
	    send $marker "markpos; set imageText False; redraw"
	}
    } else { 
	if { [true $TextBkgd] } {
	    set TextBkgd False
	} else {
	    set TextBkgd True
	}
        for {set i 1} {$i <= $n} {incr i} {
	    set markerlist [lindex $mlist [expr $i-1]]
	    set m [lindex $markerlist 0]
	    set err [catch { set region_mapped [send $m getPreciseRegion] }]
	    if { $err == 0 } {
		if {  [lindex $region_mapped 0] != "text" } {
		    continue
		}
		send $m "markpos; set imageText $TextBkgd; redraw"
	     }
	}
    }
}

#
# CreateTextMarker -- create a new text marker
#
# Usually we call this routine intially from a button press and thus
# have values for x and y but no value for the text string.  In this case,
# we save the x and y positions and we bring up a dialog box which prompts
# for the text string.  We then call this routine again with the text string
# but no x and y, grabbing the previous x and y to put up the text
#
proc CreateTextMarker { { text "" } { x 0 } { y 0 } } \
{
    global marker markno frame
    global markertext marker_x marker_y
    global wcs_color

    # first time through, we have x and y but not the text
    if { $x != 0 } {
	set marker_x $x
    } else {
	set x $marker_x
    }
    if { $y != 0 } {
	set marker_y $y
    } else {
	set y $marker_y
    }
    # second time through, we have text but not x and y
    if { ( $text == "" ) || ( $text == "?" ) } {
	set text $markertext
    }

    # get window width and height, taking tiling into account
    GetTiledWinSize winWidth winHeight sx sy

    # if we have text, put it up
    if { $text != "" } {
	if { ( $x == 0 ) && ( $y == 0 ) } {
	    set x [expr $winWidth / 2 + $sx ]
	    set y [expr $winHeight / 2  + $sy]
	}
	GetTextDimensions "$text" height width
	CreateMarker "+" $wcs_color "" "text" $x $y $width $height 0 $text
	set markertext ""
	set marker_x  [expr $winWidth / 2 + $sx]
	set marker_y  [expr $winHeight / 2 + $sy]
    } else {
	# this happens the first time through -- we have x and y but not text
	# so we pop up a dialog box with the text in it
	GetMarkerText
    }
}

proc GetTextDimensions { text rheight rwidth } {
	upvar 1 $rwidth width $rheight height
	set length [string length $text]
	set height 1
	set width 0
	set curw 0
        for {set i 0} {$i <= $length} {incr i} {
	  incr curw
	  set j [expr $i + 1]
	  if { [string range $text $i $i] == "\n" } {
		incr height
		if { $curw > $width } {
		    set width $curw
		}
		set curw 0
	  } elseif { ([string range $text $i $i] == "\\") && ([string range $text $j $j] == "n") } {
		incr height
		if { $curw > $width } {
		    set width $curw
		}
		set curw 0
	  }
	}
	if { $width == 0 } {
	    set width [string length $text]
	}
	# avoid bug in Gterm that loses last line ... too lazy to find it!
	if { $height > 1 } {
	    incr height
	}
	set width [format "%sch" $width]
	set height [format "%sch" $height]
}

#
# DefTextMarker -- put a text marker at the center (it can be moved)
#
proc DefTextMarker args {
    CreateTextMarker ? 0 0
}

# translations for text markers
set textMarkerTranslations { \
	  <Btn1Down>:  m_raise() m_markposAdd() call(UpSaM)
	<Btn1Motion>:  m_move() 
	    <Btn1Up>:  m_redraw()
	  <Btn2Down>:  m_raise()  m_markposAdd() call(UpSaM)
	    <Btn2Up>:  m_redraw()
	<Btn2Motion>:  m_move()
       Any<Btn3Down>:  popup(textMarkerMenu,$x,$y)
	 Any<Btn3Up>:  popdown(textMarkerMenu)
      <Key>BackSpace:  call(set,xm,$marker) call(SavM) m_deleteDestroy() call(DelMlist,$xm)
	 <Key>Delete:  call(set,xm,$marker) call(SavM) m_deleteDestroy() call(DelMlist,$xm)
	      <Key>+:  call(TransM, $x, $y, 1, 1, 0, 0)
	      <Key>-:  call(TransM, $x, $y, -1, -1, 0, 0)
  ~Shift<Key>#KPLeft:  call(TransM, $x, $y, 0, 0, -1, 0)
 ~Shift<Key>#KPRight:  call(TransM, $x, $y, 0, 0, 1, 0)
    ~Shift<Key>#KPUp:  call(TransM, $x, $y, 0, 0, 0, -1)
  ~Shift<Key>#KPDown:  call(TransM, $x, $y, 0, 0, 0, 1)
  !Shift<Key>#KPLeft:  call(TransM, $x, $y, 0, 0, -5, 0)
 !Shift<Key>#KPRight:  call(TransM, $x, $y, 0, 0, 5, 0)
    !Shift<Key>#KPUp:  call(TransM, $x, $y, 0, 0, 0, -5)
  !Shift<Key>#KPDown:  call(TransM, $x, $y, 0, 0, 0, 5)
}
regsub -all #KP $textMarkerTranslations  $KeyboardPrefix textMarkerTranslations

#
# TEXTMARKER
#
proc EditTextMarkerMenu args {
	global marker

	set err [catch {send $marker "getAttributes fix fix"}]
	if { $err == 1 } {
	    set fix 0
	}
	set itemlist ""
	lappend itemList {"Text Marker Options" f.title}
	lappend itemList { f.dblline }
	lappend itemList { "Set Name (and Color) ..."	f.menu	markerType }
	lappend itemList { "Set Color ..."		f.menu	markerColor }
	lappend itemList { "Edit the Text String"	f.exec  EditText }
	lappend itemList { "Toggle This Background" 	\
			    f.exec "ToggleImageText $marker" }
	lappend itemList { f.line }
	lappend itemList { "Display This Marker's Fix Params"	\
				f.exec  DisplayFixParams  sensitive $fix}
	lappend itemList { "Edit This Marker's Fix Params"  \
						f.exec  NewFixParams2 }
	lappend itemList { "Fix This Marker Using Global Fix Params"  \
						f.exec  ToggleFixed }
	lappend itemList { "Free Marker"	f.exec  ToggleFixed  sensitive $fix}
	lappend itemList { f.line }
	lappend itemList { Destroy f.exec { DeleteMarker $marker } }
    editMenu textMarkerMenu toplevel $itemList
    ReBland  textMarkerMenu
}

# #############################################################################
#
# TEXTMARKER -- text attached to any marker
#
# #############################################################################

set mymarkertext ""

proc attachMarkerText { text marker } {
    send $marker "markpos; \
	 setAttributes text \"$text\" markerTextDisplay 1; \
	 redraw"
}

proc myGetMarkerText args {
    global marker mymarkertext
    set err [catch {send $marker "getAttributes text t"}]
    if { $err == 1 } {
	set mymarkertext ""
    } else {
	set mymarkertext "$t"
    }
    startDialog "Enter/Edit a text string: " \
	"attachMarkerText \$mymarkertext $marker" \
	"$mymarkertext" "mymarkertext" "xeq"
}

proc ToggleTextDisplay args {
    global marker
    set err [catch {send $marker "getAttributes markerTextDisplay td"}]
    if { $err == 1 } {
	set td True
    } else {
	if { $td } {
	  set td False
	} else {
	  set td True
	}
    }
    send $marker "markpos; setAttributes markerTextDisplay $td; redraw"
}

proc ToggleFixed args {
    global marker
    global MarkerFixParams

    set err [catch {send $marker "getAttributes fix fix"}]
    if { $err == 1 } {
	set fix 0
    } else {
	if { $fix } {
	  set fix 0
	} else {
	  set fix -1
	}
    }
    if { $fix == 0  } {
        SetFixParams "none"
    } else {
	SetFixParams
    }
}

# #############################################################################
#
# The marker list -- used to keep track of active markers
#
# #############################################################################

set mlist ""			;# current list of include markers

#
# AddMlist -- add a marker to the marker list
#
proc AddMlist { marker frame ie rname color } {
    global mlist
    lappend mlist [list $marker $frame $ie $rname $color]
}

#
# EditMList -- change the include/exclude status of the current marker
#
proc EditMList { param value mm } {
    global mlist
    global nrname rnames rcolors

    set ilist $mlist
    set n [llength $ilist]
    set olist ""

    for {set i $n} {$i >= 1} {incr i -1} {
	set markerlist [lindex $ilist [expr $i-1]]
	set m [lindex $markerlist 0]
	set f [lindex $markerlist 1]
	set ie [lindex $markerlist 2]
	# if this is the correct marker ...
	if { $m == $mm } {
	  # change the value
	  switch $param {
	    IE {	
		# set new include/exclude
		if { $value == "-" } {
		    set markerlist [lreplace $markerlist 2 2 $value]
                    send $m "markpos; setAttributes lineStyle 1; redraw"
		} elseif { $value == "+" } {
		    set markerlist [lreplace $markerlist 2 2 $value]
		    send $m "markpos; setAttributes lineStyle 0; redraw"
		}
	    }
	    RNAME {
		# set new name
		set markerlist [lreplace $markerlist 3 3 $value]

		# mess with rnames as well
		for {set j 0} {$j < $nrname} {incr j} {
		    if { $value == $rnames($j) } {
			# change the name as well
		        set markerlist [lreplace $markerlist 4 4 $rcolors($j)]
		    }
		}
	    }
	    COLOR {
		# set new color
		set markerlist [lreplace $markerlist 4 4 $value]

		# see if this is a color with an assoc. name
		# set name to color, just in case
		set markerlist [lreplace $markerlist 3 3 $value]
		for {set j 0} {$j < $nrname} {incr j} {
		    if { $value == $rcolors($j) } {
			# change the name as well
		        set markerlist [lreplace $markerlist 3 3 $rnames($j)]
		    }
		}
	    }
	  }
	  set mlist [lreplace $mlist [expr $i - 1] [expr $i - 1] $markerlist]
	  break
	}
    }
}

#
# DelMlist -- delete a marker from the marker list
# (someone else actually deleted the marker)
#
proc DelMlist { xm } {
    global mlist marker markno frame
    global hold_region save_region

    # if this marker was not deleted (might have been fixed), just exit
    set err [catch { set region [send $xm getPreciseRegion] }]
    if { $err == 0 } {
	return
    }

    set ilist $mlist
    set n [llength $ilist]
    set olist ""
    for {set i 1} {$i <= $n} {incr i} {
	set markerlist [lindex $ilist [expr $i-1]]
	set m [lindex $markerlist 0]
        set f [lindex $markerlist 1]
	# append to list if its not the one we want to delete
	if { $xm != $m } {
	    # redraw marker in case it was obscured by deletion
	    if { $frame == $f } {
		send $m "redraw"
	    }
	    lappend olist $markerlist
	} else {
	    # catch cases where we just deleted 1 point of the marker
	    # or where the marker was not deleted because it was fix'ed
	    set err [catch { set region [send $xm getPreciseRegion] }]
	    if { $err == 0 } {
		# redraw marker in case it was obscured by deletion
		if { $frame == $f } {
		    send $xm "redraw"
		}
	        lappend olist $markerlist
	    } else {
		# if we just deleted the region, save it for undoing
	        if { [info exists hold_region($frame)] } {
		    set save_region($frame) $hold_region($frame)
		    unset hold_region($frame)
		}
	    }
	}
    }
    # this is the new mlist
    set mlist $olist
}

#
# CleanMlist -- clean out bogus markers from the marker list
#
proc CleanMlist args \
{
    global mlist

    # need a temp list, since we will modify the original list
    set ilist $mlist
    set n [llength $ilist]
    set olist ""
    for {set i 1} {$i <= $n} {incr i} {
	set markerlist [lindex $ilist [expr $i-1]]
	set m [lindex $markerlist 0]
	set f [lindex $markerlist 1]
	set region "none"
	set err [catch { set region [send $m getPreciseRegion] }]
	if { $err == 0 } {
	    lappend olist $markerlist
	}
    }
    # this is the new mlist
    set mlist $olist
}

#
# ViewMlist -- view all markers in this frame
#
proc ViewMlist args \
{
  global frame

  Print [format "Region markers for frame %s:" $frame]
  SendRegions $frame "all" "yes+" "NONE"
  MessDisplay
}

set mlist_hidden 0
#
# HideMlist -- hide all markers
#
proc HideMlist args \
{
    global mlist mlist_hidden
    set n [llength $mlist]
    # set visible to false for all frames
    for {set i 1} {$i <= $n} {incr i} {
	set markerlist [lindex $mlist [expr $i-1]]
	set m [lindex $markerlist 0]
	send $m setAttribute visible False
    }
    set mlist_hidden 1
}

#
# FrameMlist -- display markers in this frame
#
proc FrameMlist args \
{
    global frame
    global mlist
    global tileframe blinkFrames
    global mlist_hidden

    # not hidden anymore
    set mlist_hidden 0

    # if we have tiled frames, we need to determine if this frame
    # if one of them
    set len [llength $blinkFrames]
    set intile 0
    if { $tileframe } {
        for {set j 0} {$j < $len} {incr j} {
	    set tframe [lindex $blinkFrames $j]
	    if { $tframe == $frame } {
		set intile 1
		break
	     }
        }
    }

    set n [llength $mlist]
    for {set i 1} {$i <= $n} {incr i} {
	set markerlist [lindex $mlist [expr $i-1]]
	set m [lindex $markerlist 0]
	set f [lindex $markerlist 1]
	# if we are tiling, we redisplay all markers in each tile
	if { $intile } {
	    set got 0
	    # look for this frame in the list of tiled frames
	    for {set j 0} {$j < $len} {incr j} {
		set tframe [lindex $blinkFrames $j]
		if { $tframe == $f } {
		    set got 1
		    break
	 	}
	    }
	    # when tiling, don't show markers that go off the tile
	    if { $got } {
		send $m "getAttributes precisex x precisey y"
		GetTiledWinSize width height sx sy $f
		if { ($x < $sx) || ($x > [expr $sx + $width]) } {
		    set got 0
		} 
		if { ($y < $sy) || ($y > [expr $sy + $height]) } {
		    set got 0
		} 
	    }	
	    # display if active
	    if { $got } {
		send $m "markpos; setAttribute visible True; redraw"
	    } else {
		send $m "markpos; setAttribute visible False; redraw"
	    }
	} else {
	    # display if active
	    if { $f == $frame } {
		send $m "markpos; setAttribute visible True; redraw"
	    } else {
		send $m "markpos; setAttribute visible False; redraw"
	    }
	}
    }
}

#
# ToggleTextMlist -- toggle display of text
#
proc ToggleTextMlist args \
{
    global mlist frame
    global TextDisplay

    set TextDisplay [expr !$TextDisplay]
    set n [llength $mlist]
    for {set i 1} {$i <= $n} {incr i} {
	set markerlist [lindex $mlist [expr $i-1]]
	set m [lindex $markerlist 0]
	set f [lindex $markerlist 1]
	if { $frame == $f } {
	    send $m "markpos; \
	    setAttributes markerTextDisplay $TextDisplay; \
	    redraw"
	} else {
	    send $m "setAttributes markerTextDisplay $TextDisplay"
	}
    }
}

#
# FixMlist -- toggle display of text
#
proc FixMlist { state  } \
{
    global mlist frame

    set n [llength $mlist]
    for {set i 1} {$i <= $n} {incr i} {
	set markerlist [lindex $mlist [expr $i-1]]
	set m [lindex $markerlist 0]
	set f [lindex $markerlist 1]
        send $m fix $state
    }
}

#
# ReColorMlist -- update the colors of all markers to match the
# current name/color association
#
proc ReColorMlist { type } \
{
    global mlist frame
    global nrname rnames rcolors

    set n [llength $mlist]
    for {set i 0} {$i < $n} {incr i} {
	set markerlist [lindex $mlist $i]
	set m [lindex $markerlist 0]
	set f [lindex $markerlist 1]
	set rname [lindex $markerlist 3]
	set rcolor [lindex $markerlist 4]
	if { $type == "name" } {
	    for {set j 0} {$j < $nrname} {incr j} {
		if { $rname == $rnames($j) } {
		    set color $rcolors($j)
	            send $m "markpos; \
			set textColor $color; \
			set lineColor $color; \
			set highlightColor $color"
	            EditMList COLOR $color $m
		    if { $f == $frame } {
		        send $m "redraw"
		    }
		}
	    }
	} elseif { $type == "color" } {
	    for {set j 0} {$j < $nrname} {incr j} {
		if { $rcolor == $rcolors($j) } {
		    m_setRName $rnames($j) $m
		}
	    }
	}
    }
}

#
# TileMlist -- recalculate pan/zoom positions cursors when tiling
#
proc TileMlist { flag } \
{
    global frame mlist
    global winWidth winHeight
#   global dont_panzoomCursors

    # avoid marker flashing
# already done
#    HideMlist

    set n [llength $mlist]
    # look though all cursors
    for {set i 1} {$i <= $n} {incr i} {
	set markerlist [lindex $mlist [expr $i-1]]

	set m [lindex $markerlist 0]
	set f [lindex $markerlist 1]
	GetTiledWinSize width height sx sy $f

	set err [catch { set region [send $m getPreciseRegion] }]
	if { $err == 0 } {
	    if { $flag } {
		set oldWinWidth $winWidth
		set oldWinHeight $winHeight
		set newWinWidth $width
		set newWinHeight $height
	    } else {
		set newWinWidth $winWidth
		set newWinHeight $winHeight
		set oldWinWidth $width
		set oldWinHeight $height
		set sx [expr -$sx]
		set sy [expr -$sy]
	    }

	    set h [expr ($newWinWidth - $oldWinWidth + 0.0) / 2.0 + $sx]
	    set v [expr ($newWinHeight - $oldWinHeight + 0.0) / 2.0 + $sy]
	    set name [lindex $region 0]

	    # move the cursor to its position in the new frameView
	    if { ($name == "polygon") || ($name == "line") } {
		    send $m getAttributes precisex bogus_x precisey bogus_y
		    set bogus_x [expr $bogus_x + 0.0]
		    set bogus_y [expr $bogus_y + 0.0]
	    } else {
		    set bogus_x [lindex $region 2]
		    set bogus_y [lindex $region 3]
	    }

	    # these are the new x,y positions
	    set xnew [expr $bogus_x + $h]
	    set ynew [expr $bogus_y + $v]

	    # temporarily free the marker
	    send $m getAttributes fix fix
	    send $m setAttributes fix 0

	    # move the marker
	    send $m move $xnew $ynew

	    # reset the fixed state
	    send $m setAttributes fix $fix
	}
    }

    FrameMlist
    # NB: this must be unset, for some strange reason
#   set dont_panzoomCursors 0
}

#
# CountMlist -- count the number of markers in this frame
#
proc CountMlist { n } \
{
    upvar 1 $n got
    global mlist frame

    set n [llength $mlist]
    set got 0
    for {set i 1} {$i <= $n} {incr i} {
	set markerlist [lindex $mlist [expr $i-1]]
	set m [lindex $markerlist 0]
	set f [lindex $markerlist 1]
	if { $f != $frame } {
	    continue
	}
	set region "none"
	set err [catch { set region [send $m getPreciseRegion] }]
	if { $err == 0 } {
	    incr got
	}
    }
}

# ############################################################################
#
# Region-specific routines
#
# ############################################################################

#
# DisplayColors -- display possible colors for markers
#
proc DisplayColors args {
    global colors
    Print "Colors For Markers: "
    Print [array names colors]
    MessDisplay
}

#
# RegionsCallback -- Called when the client is requesting a region list
#
proc RegionsCallback { param old new } { 
    # new can be: {frame}, {frame marker}, or {frame marker display}
    set len [llength $new]
    if { $len == 1 } {
        set frame $new
	set marker "all"
	set display "no"
    } elseif { $len == 2 } {
        set frame [lindex $new 0]
	set marker [lindex $new 1]
	set display "no"
    } else {
        set frame [lindex $new 0]
	set marker [lindex $new 1]
	set display [lindex $new 2]
    }
    SendRegions $frame $marker $display "NONE"
}
send regions addCallback RegionsCallback

set nrname 0
proc RegionNamesCallback { param old new } { 
    global nrname rnames rcolors
    global DefaultColor

    set roption [lindex $new 0]
    set rlist [lindex $new 1]
    set list [split $rlist "\n"]
    set n [llength $list]
    set k 0
    if { $roption == "append" } {
	set base $nrname
    } else {
	set base 0
    }
    for {set i 0} {$i < $n} {incr i} {
	set entry [lindex $list $i]
	if { [string index $entry 0] == "#" } {
	  continue
	}
	set j [llength $entry]
	if { $j < 2 } {
	  continue
	}
	set offset [expr $base + $k] 
	set rnames($offset) [lindex $entry 0]
	set rcolors($offset) [lindex $entry 1]
	incr k
    }
    set nrname [expr $base + $k]
    if { $DefaultColor == "none" } {
	set DefaultColor $rcolors(0)
    }
    editMenu markerType toplevel [makeTypeMenu]
    ReBland markerType
    editMenu regionNameMenu toplevel [makeRnameMenu]
    ReBland regionNameMenu
}
send regionnames addCallback RegionNamesCallback


#
# DisplayRNames -- display current region name/color mappings
#
proc DisplayRNames args {
    global nrname rnames rcolors
    Print "Current Region Name/Color Associations:"
    for {set i 0} {$i < $nrname} {incr i} {
	set name [format "%s:" $rnames($i)]
	Print [format "%-24s    %s" $name $rcolors($i)]
    }
    MessDisplay
}

#
# LoadNewRNames -- pop up dialog to load a new set of rnames
#
set rnamestring ""
proc LoadNewRNames args {
    global rnamesstring
    global nrname rnames rcolors

    set rnamestring "# replace"
    for {set i 0} {$i < $nrname} {incr i} {
	set rnamestring [join [list $rnamestring [list $rnames($i) $rcolors($i)]] "\n"]
    }
    regsub -all "{" $rnamestring "\"" rnamestring
    regsub -all "}" $rnamestring "\"" rnamestring
    startDialog "Edit the region names/colors: " \
	"SendNewRNames" "$rnamestring" "rnamestring" "xeq"
}

#
# SendNewRnames -- execute the xpa command to load a new set of region names
#
proc SendNewRNames args {
    global rnamestring
    if { $rnamestring != "" } {
      SendXPA "regionnames '$rnamestring'"
    }
}

# SendRegion -- send 1 region
# This is optimized for 1 region to speed up loading regions from
# an external source
#
proc SendRegion {frame which display {file "NONE"}} {
    global mlist marker

    set rlist ""
    set n [llength $mlist]
    for {set i $n} {$i >= 1} {incr i -1} {
	set markerlist [lindex $mlist [expr $i-1]]
	set m [lindex $markerlist 0]
	# if a specific marker was specified, display only that marker
	if { $m != $which } {
	    continue
	}
	# skip null regions
	if { $m == "" } {
	    continue
	}
	set f [lindex $markerlist 1]
	set ie [lindex $markerlist 2]
	set rname [lindex $markerlist 3]
	set colr [lindex $markerlist 4]
	# just the regions in the requested frame 
	if { $frame == $f } {
	    set err [catch { set region_mapped [send $m getPreciseRegion] }]
	    if { $err == 0 } {
		set region_unmap [unmapRegion $region_mapped]
		GetFixParams $m fix
		if { $m == $marker } {
		    set active "T"
		} else {
		    set active "F"
		}
		set name [lindex $region_unmap 0]
		if {  $name != "text" } {
		  set err  [send $m "getAttributes text text"]
		  set params [lrange $region_unmap 2 [llength $region_unmap]]
		} else {
		  send $m "getAttributes text s"
		  regsub -all "\n" $s  "\\n\\\n" s
		  set params \
			[format "%s \"%s\"" [lrange $region_unmap 2 3] $s]
		  set text ""
		}
		set region [format "%s '%s' %s %s '%s' %s %s" \
				$active $fix $colr $ie $rname $name $params]
	        if { $text != "" } {
		   set text [format "#%s" $text]
		   lappend rlist $text
		}
		lappend rlist $region
		break;
	    }
	}
    }

    send client regions $file $display $rlist
}

#
# SendRegions -- send region list to client
#
proc SendRegions {frame which display {file "NONE"}} {
    global mlist marker

    set rlist ""
    set n [llength $mlist]
    for {set i 1} {$i <= $n} {incr i} {
	set markerlist [lindex $mlist [expr $i-1]]
	set m [lindex $markerlist 0]
	# if a specific marker was specified, display only that marker
	if { $which != "all" } {
	    if { $m != $which } {
		continue
	    }
	}
	# skip null regions
	if { $m == "" } {
	    continue
	}
	set f [lindex $markerlist 1]
	set ie [lindex $markerlist 2]
	set rname [lindex $markerlist 3]
	set colr [lindex $markerlist 4]
	# just the regions in the requested frame 
	if { $frame == $f } {
	    set err [catch { set region_mapped [send $m getPreciseRegion] }]
	    if { $err == 0 } {
		set region_unmap [unmapRegion $region_mapped]
		GetFixParams $m fix
		if { $m == $marker } {
		    set active "T"
		} else {
		    set active "F"
		}
		set name [lindex $region_unmap 0]
		if {  $name != "text" } {
		  set err  [send $m "getAttributes text text"]
		  set params [lrange $region_unmap 2 [llength $region_unmap]]
		} else {
		  send $m "getAttributes text s"
		  regsub -all "\n" $s  "\\n\\\n" s
		  set params \
			[format "%s \"%s\"" [lrange $region_unmap 2 3] $s]
		  set text ""
		}
		set region [format "%s '%s' %s %s '%s' %s %s" \
				$active $fix $colr $ie $rname $name $params]
	        if { $text != "" } {
		   set text [format "#%s" $text]
		   lappend rlist $text
		}
		lappend rlist $region
	    }
	}
    }

    send client regions $file $display $rlist
}

#
# unmapRegion -- unmaps any region on the main image, regardless of 
#                whether it is currently mapped to the main window
#  Intended for external communication of region descriptions, using 
#    IRAF coordinate conventions (1st pixel == (1,1) ).
#  (Don't use this from within panzoomCursors; that routine must do 
#   its own unmapping, when frameView is changing.)
#
set PI 3.141592653589793238462643

proc unmapRegion {region_mapped} {
    global frameWidth frameHeight
    global frame
    global frameZoomX frameZoomY 
    global frameCenterX frameCenterY
    global frameScaleX frameScaleY
    global xflip yflip
    global PI
    global debug

    # get window width and height, taking tiling into account
    GetTiledWinSize winWidth winHeight sx sy

    set xzoom [expr double($frameZoomX($frame)) * $frameScaleX($frame)]
    set yzoom [expr double($frameZoomY($frame)) * $frameScaleY($frame)]

    # region_mapped:  shape raster xcen ycen width [height [rotangle] ]
    #  (e.g., the value returned by getPreciseRegion)

    set region_unmap ""
    set name [lindex $region_mapped 0]

    lappend region_unmap $name
    lappend region_unmap [lindex $region_mapped 1]

    if { ($name != "polygon") && ($name != "line") } {

        # compute unmapped x
        set x_mapped [expr [lindex $region_mapped 2] + 0.0]
        set xu_offset [expr \
	    ($winWidth/$xzoom) * (double($x_mapped-$sx)/$winWidth-0.5)]
        if {$xflip} {
	    set xu_offset [expr -$xu_offset]
        }
	set x_unmapped [expr double($frameCenterX($frame)) + $xu_offset]
	if { [expr int($winWidth/$xzoom) % 2] == 1 } {
	    set x_unmapped [expr $x_unmapped - 0.5]
	}
        lappend region_unmap $x_unmapped

        # compute unmapped y
        set y_mapped [expr [lindex $region_mapped 3] + 0.0]
        set yu_offset [expr \
	  ($winHeight/$yzoom) * (double($y_mapped-$sy)/$winHeight-0.5)]
        if {$yflip} {
	    set yu_offset [expr -$yu_offset]
        }
	set y_unmapped [expr double($frameCenterY($frame)) + $yu_offset]
	if { [expr int($winHeight/$yzoom) % 2] == 1 } {
	    set y_unmapped [expr $y_unmapped - 0.5]
	}
        lappend region_unmap $y_unmapped

	if { $name != "point" } {
            # compute unmapped width
            lappend region_unmap [expr [lindex $region_mapped 4] / $xzoom]

            # compute unmapped height
            if {$name == "ellipse" || $name == "rectangle"} {
	        lappend region_unmap [expr [lindex $region_mapped 5] / $yzoom]
            }

            # rotangle was changed if xflip != yflip
            if { [lindex $region_mapped 6] != "" } {
	        set rot [lindex $region_mapped 6]
	        if { ( $rot != 0.0 ) && ( $xflip != $yflip ) } {
	            set rot [expr -$rot]
	        }
	        # convert to degrees
	        set rot [expr ( $rot * 180.0 ) / $PI]
	        lappend region_unmap $rot
            }
	}

    } else {

      set npts [lindex $region_mapped 2]
      set point_list [lindex $region_mapped 3]

      for {set i 0} {$i < $npts} {incr i} {

        # compute unmapped x
        set x_mapped [expr [lindex [lindex $point_list $i] 0] + 0.0]
        set xu_offset [expr \
	    ($winWidth/$xzoom) * (double($x_mapped-$sx)/$winWidth-0.5)]
        if {$xflip} {
	    set xu_offset [expr -$xu_offset]
        }
	set x_unmapped [expr double($frameCenterX($frame)) + $xu_offset]
	if { [expr int($winWidth/$xzoom) % 2] == 1 } {
	    set x_unmapped [expr $x_unmapped - 0.5]
	}
        lappend region_unmap $x_unmapped

        # compute unmapped y
        set y_mapped [expr [lindex [lindex $point_list $i] 1] + 0.0]
        set yu_offset [expr \
	  ($winHeight/$yzoom) * (double($y_mapped-$sy)/$winHeight-0.5)]
        if {$yflip} {
	    set yu_offset [expr -$yu_offset]
        }
	set y_unmapped [expr double($frameCenterY($frame)) + $yu_offset]
	if { [expr int($winHeight/$yzoom) % 2] == 1 } {
	    set y_unmapped [expr $y_unmapped - 0.5]
	}
	lappend region_unmap $y_unmapped
      }

    }

    # pass it all back
    return $region_unmap
}

# #############################################################################
#
# New cursor stuff
#
# #############################################################################

#
# GetTiledWinSize  -- each time we use winWidth or winHeight, we
# need to take into account whether we are tiled or not
# 
#
proc GetTiledWinSize { width height sx sy { xframe "" } } {
    upvar 1 $width fwidth $height fheight
    upvar 1 $sx fsx $sy fsy
    global winWidth winHeight
    global tileframe blinkFrames
    global frame

    # default is to use the current frame
    if { $xframe == "" } {
	set xframe $frame
	set force 0
    } else {
	set force 1
    }

    # if we are not tiling frames, just return the real frame sizes
    if { !$tileframe && !$force } {
	set fwidth $winWidth
	set fheight $winHeight
	set fsx 0
	set fsy 0
	return
    }

    set got 0
    set len [llength $blinkFrames]
    # look for this frame in the list of tiled frames
    for {set i 0} {$i < $len} {incr i} {
        set tframe [lindex $blinkFrames $i]
	if { $tframe == $xframe } {
	    set got [expr $i + 1]
	    break
	}
    }

    # if this frame is not in the tiled frames, return the real window sizes
    if { $got == 0 } {
	set fwidth $winWidth
	set fheight $winHeight
	set fsx 0
	set fsy 0
	return
    }

    # calculate the window sizes, based on the number of tiles
    switch $len {
	1 {
	    set fwidth $winWidth
	    set fheight $winHeight
	}
	2 {
	    set fwidth [expr $winWidth / 2]
	    set fheight $winHeight
	}
	3 {
	    set fwidth [expr $winWidth / 2]
	    set fheight [expr $winHeight / 2]
	}
	4 {
	    set fwidth [expr $winWidth / 2]
	    set fheight [expr $winHeight / 2]
	}
    }
    switch $got {
	1 {
	    set fsx 0
	    set fsy 0
	}
	2 {
	    set fsx [expr $winWidth / 2 - 2]
	    set fsy 0
	}
	3 {
	    set fsx 0
	    set fsy [expr $winHeight / 2 - 2]
	}
	4 {
	    set fsx [expr $winWidth / 2 - 2]
	    set fsy [expr $winHeight / 2 - 2]
	}
    }

}

proc translateCoords {  old_x old_y \
		 	xcen_old ycen_old xzoom_old yzoom_old \
			xcen_new ycen_new xzoom_new yzoom_new \
			new_x new_y } \
{
    upvar 1 $new_x x_new $new_y y_new
    global xflip yflip
    global debug

    # get window width and height, taking tiling into account
    GetTiledWinSize winWidth winHeight sx sy

    # compute new x
    set xu_offset [expr (($winWidth + 0.0) / $xzoom_old) * (($old_x - $sx) / $winWidth - 0.5)]
    if {$xflip} {
	set xu_offset [expr -$xu_offset]
    }
    set x_unmap [expr $xcen_old + $xu_offset ]
    set xn_offset [expr $x_unmap - $xcen_new ]
    if {$xflip} {
	set xn_offset [expr -$xn_offset]
    }
    set x_new [expr $winWidth * ($xzoom_new * $xn_offset / $winWidth + 0.5) + $sx]

    # compute new y
    set yu_offset [expr (($winHeight + 0.0) / $yzoom_old ) * (($old_y - $sy) / $winHeight - 0.5)]
    if {$yflip} {
	set yu_offset [expr -$yu_offset]
    }
    set y_unmap [expr $ycen_old + $yu_offset ]
    set yn_offset [expr $y_unmap - $ycen_new ]
    if {$yflip} {
	set yn_offset [expr -$yn_offset]
    }
    set y_new [expr $winHeight * ($yzoom_new * $yn_offset / $winHeight + 0.5) + $sy]

    if {$debug} {
	print [format ".....       old x = %f" $old_x ]
	print [format ".....  unmapped x = %f" $x_unmap ]
	print [format ".....       new x = %f" $x_new ]
	print [format ".....       old y = %f" $old_y ]
	print [format ".....  unmapped y = %f" $y_unmap ]
	print [format ".....       new y = %f" $y_new ]
    }
}

proc TranslateCursor { x y h v } \
{
    send imagewin setCursorPos [expr $x + $h] [expr $y + $v]
}

# panzoomCursors -- This is called in response to a frameView event when the 
# main display mapping changes; e.g., when the frame changes or the user 
# zooms or pans the main window.  If the frame has changed, there is no need 
# to adjust the cursors, and there is an immediate return.  Zooming or 
# panning a frame requires redrawing the cursors.

# hidden variable that prevents markers from being made visible
# in case we are doing several pans/zooms in succession
set panzoomvisible 1

proc panzoomCursors {param old new} {
    global panzoomvisible
#   global dont_panzoomCursors 
    global frame frameWidth frameHeight
    global mlist
    global debug
    global FixType FixPosition FixSize FixRotation FixPoints FixDelete 
    global FixZoom FixZoomSize
    global frameViews
    global mlist_hidden

    if {$debug} {
	print " "
	print [format "in panzoomCursors for frame: %s" $frame]
	print [format "+++ old %s: %s" $param $old]
	print [format "+++ new %s: %s" $param $new]
        if { [info exists frameViews($frame)] } {
	    print [format "+++    frameViews: %s" $frameViews($frame)]
	}
    }

    # usually we are called using frameView, in which case we use
    # the previous info for this specific frame
    if { $param == "frameView" } {
        if { [info exists frameViews($frame)] == 0 } {
	    if { $mlist_hidden } {
		FrameMlist
	    }
	    return
	} else {
	    set prev $frameViews($frame)
	}
    # sometime we are called with 2 special arguments
    } else {
	set prev $old
    }

    # make sure we have something that needs doing
    if { ($prev == "") || ($prev == $new) } {
        if { $mlist_hidden } {
	    FrameMlist
	}
	return
    }

# not needed any longer
#    if {$dont_panzoomCursors} {
#	set dont_panzoomCursors 0
#	if {$debug} {
#	    print "dont_panzoomCursors is set ... exiting routine ..."
#	}
#	return
#    }

    # old, new:  xzoom, yzoom, xcen, ycen, xscale, yscale
    # bring old and new frameView parameters into local variables
    set xzoom_old  [expr [lindex $prev 0] * [lindex $prev 4]]
    set yzoom_old  [expr [lindex $prev 1] * [lindex $prev 5]]
    set xcen_old   [lindex $prev 2]
    set ycen_old   [lindex $prev 3]

    set xzoom_new  [expr [lindex $new 0] * [lindex $new 4]]
    set yzoom_new  [expr [lindex $new 1] * [lindex $new 5]]
    set xcen_new   [lindex $new 2]
    set ycen_new   [lindex $new 3]

    if {$xzoom_new != $xzoom_old || $yzoom_new != $yzoom_old} {
	set xzoom_change [expr double($xzoom_new) / $xzoom_old]
	set yzoom_change [expr double($yzoom_new) / $yzoom_old]
	if {$debug} {
	    print [format "+++ xzoom:  old, new, change: %s, %s, %s" \
			$xzoom_old $xzoom_new $xzoom_change]
	    print [format "+++ yzoom:  old, new, change: %s, %s, %s" \
			$yzoom_old $yzoom_new $yzoom_change]
	}
	set do_resize 1
    } else {
	set do_resize 0
    }

    # set up the input list of markers
    set ilist $mlist
    set n [llength $ilist]

    # set visible to false to avoid cursor flashing
    HideMlist

    # look though all cursors
    for {set i 1} {$i <= $n} {incr i} {
	set markerlist [lindex $ilist [expr $i-1]]
	set f [lindex $markerlist 1]
	# transform this cursor only if it's in the current frame
	# (### This assumes that the frame in the frameRegion parameter 
	#  updated immediately before updating the frameView parameter 
	#  is the current frame.)

	if { $f == $frame } {

	    if {$debug} {
		print [format "... next marker = %s" $markerlist]
	    }
	    set m [lindex $markerlist 0]
	    set region "none"

	    # get the mapped ("screen") coordinates and dimensions of 
	    #  the cursor, left over from the old frameView

	    set err [catch { set region [send $m getPreciseRegion] }]
	    if { $err == 0 } {

		set name [lindex $region 0]

		if {$debug} {
		    print [format "...  %s" $region]
		    set region_u [send $m getPreciseRegion unmap]
		    print [format "...  %s (unmapped)" $region_u]
		}

		# get fix attributes
		send $m getAttributes fix fix
		# skip if we have fixed all zooming 
		if { $fix & $FixZoom } {
		    continue
		}
		# temporarily free markers
		send $m setAttributes fix 0

		#
		# move the cursor to its position in the new frameView
		#

		if { ($name == "polygon") || ($name == "line") } {
		    send $m getAttributes precisex bogus_x precisey bogus_y
		    set bogus_x [expr $bogus_x + 0.0]
		    set bogus_y [expr $bogus_y + 0.0]
		} else {
		    set bogus_x [lindex $region 2]
		    set bogus_y [lindex $region 3]
		}

		# calculate new x,y center
		translateCoords $bogus_x $bogus_y \
		    $xcen_old $ycen_old $xzoom_old $yzoom_old \
		    $xcen_new $ycen_new $xzoom_new $yzoom_new \
		    x_new y_new

		# for most markers, we can just move the center
		if { ($name != "polygon") && ($name != "line") } {
		    send $m move $x_new $y_new
		} else {
		  # not fixing anything -- translate all points
		  if { !($fix & ($FixZoom | $FixZoomSize)) } {
		    # for polygons and lines, we re-calculate all vertices
		    set point_list [lindex $region 3]
		    set len [lindex $region 2]
		    set npoint_list "{ "
		    for {set j 0} {$j < $len} {incr j} {
			set point [lindex $point_list $j]
			set bogus_x [lindex $point 0]
			set bogus_y [lindex $point 1]
			translateCoords $bogus_x $bogus_y \
			    $xcen_old $ycen_old $xzoom_old $yzoom_old \
			    $xcen_new $ycen_new $xzoom_new $yzoom_new \
			    x_new y_new
			append npoint_list "{" $x_new " " $y_new "}"
		    }
		    append npoint_list " }"
		    # redraw the new polygon at the new position
		    send $m "setVertices $npoint_list;"
		  # don't resize -- just re-center the current polygon
		  } else {
		    send $m move $x_new $y_new
		  }
		}

		#
		# resize the cursor for the new frameView
		# (but we don't want to resize text or polygons)
		#
		if { $do_resize 	   && \
		    !($fix & $FixZoomSize) && \
		    ($name != "text")      && \
		    ($name != "polygon")   && \
		    ($name != "point")     && \
		    ($name != "line") }    {

		    # compute new width
		    set w_new [expr $xzoom_change * [lindex $region 4]]
		    if {$debug} {
			print [format ".....  new width  %f" $w_new]
		    }

		    # compute new height

		    if {$name == "ellipse" || $name == "rectangle"} {
			set bogus_h [lindex $region 5]
		    } else {
			set err \
			 [catch {send $m getAttributes preciseheight bogus_h} ]
			if { $err == 1 } {
			    if {$debug} {
				print ".......  (error on getting height)"
			    }
			    set bogus_h [lindex $region 4]
			}
		    }
		    set h_new [expr $yzoom_change * $bogus_h]

		    if {$debug} {
			print [format ".....  new height %f" $h_new]
		    }

		    send $m resize $w_new $h_new

	        }

		# reset the fixed state
	        send $m setAttributes fix $fix
	    }
	}
    }

    # redisplay all cursors
    if { $panzoomvisible } {
	FrameMlist
    }
    panmagRedraw

}; send frameView addCallback panzoomCursors

# flipCursors -- This is called from within SetCurrentPan when there has 
# been a change of xflip and/or yflip in frame.  It redraws the cursors 
# correctly in the flipped window.

proc flipCursors {xflip_change yflip_change} {
    global panzoomvisible
    global mlist
    global frame
    global debug
    global frameCenterX frameCenterY 
    global FixZoom

    if {!$xflip_change && !$yflip_change} {
	return
    }

    # get window width and height, taking tiling into account
    GetTiledWinSize winWidth winHeight sx sy

    if {$debug} {
	print "## arrived at tng.gui's flipCursors proc"
	print [format "...  xflip_change = %d" $xflip_change]
	print [format "...  yflip_change = %d" $yflip_change]
    }

    # set up the input list of markers
    set ilist $mlist
    set n [llength $ilist]

    # set visible to false to avoid cursor flashing
    HideMlist

    # step through the list of cursors
    for {set i 1} {$i <= $n} {incr i} {
	set markerlist [lindex $ilist [expr $i-1]]
	if {$debug} {
	    print [format "...  next marker = %s" $markerlist]
	}
	set f [lindex $markerlist 1]

	# transform this cursor only if it's in the current frame
	if { $f == $frame } {
	    set m [lindex $markerlist 0]
	    set region "none"

	    # get the mapped ("screen") coordinates and dimensions of 
	    #  the cursor, left over from before the flip
	    set err [catch { set region [send $m getPreciseRegion] }]
	    if { $err != 0 } {
		Print [format "could not get region info for cursor %s" $m]
		continue
	    }

	    # get fix attributes
	    send $m getAttributes fix fix
	    # skip if we have fixed position zooming 
	    if { $fix & $FixZoom } {
		continue
  	    }
	    # temporarily free markers
	    send $m setAttributes fix 0

	    set name [lindex $region 0]
	    if { $name == "circle" || $name == "ellipse"   || 
		 $name == "text"   || $name == "rectangle" ||
		 $name == "point" } {

		# move the cursor to its position in the flipped window
		set x [lindex $region 2]
		if {$xflip_change} {
		    set x [expr $winWidth - $x + (2 * $sx)]
		}

		set y [lindex $region 3]
		if {$yflip_change} {
		    set y [expr $winHeight - $y + (2 * $sy)]
		}

		if {$debug} {
		    print [format "...  %s" $region]
		    print [format "...  new x = %f, new y = %f" $x $y]
		}

		send $m move $x $y

		# flip rotation angle, if necessary
		if { $name != "point" } {
		    if { $xflip_change != $yflip_change } {
			set rotangle [lindex $region 6]
			if { $rotangle == "" } {
			    set rotangle 0.0
		        }
			if { $rotangle != 0.0 } {
		            set rotangle [expr -$rotangle]
		            if {$debug} {
			      print [format "...  new rotangle = %f" $rotangle]
		            }
		            send $m rotate $rotangle
		        }
		    }
		}
	    } elseif { ($name == "polygon") || ($name == "line") } {
		send $m getAttributes precisex xcen precisey ycen
		if {$xflip_change} {
		    set xcen [expr $winWidth  - $xcen + (2 * $sx)]
		}
		if {$yflip_change} {
		    set ycen [expr $winHeight - $ycen + (2 * $sy)]
		}

		set point_list [lindex $region 3]
		set len [lindex $region 2]
		set npoint_list "{ "
	        for {set j 0} {$j < $len} {incr j} {
		    set point [lindex $point_list $j]
		    set x [lindex $point 0]
		    set y [lindex $point 1]
		    if {$xflip_change} {
			set x [expr $winWidth  - $x + (2 * $sx)]
		    }
		    if {$yflip_change} {
			set y [expr $winHeight - $y + (2 * $sy)]
		    }
		    append npoint_list "{" $x " " $y "}"
		}
		append npoint_list " }"

	 	send $m "markpos; \
			setVertices $npoint_list; \
			redraw"

	    } else {
		Print [format "unsupported cursor type: %s" $name]
	    }

	    # restore fixed state
	    send $m setAttributes fix $fix
	}
    }

    # redisplay all cursors
    if { $panzoomvisible } {
	FrameMlist
    }
    panmagRedraw

};

# #############################################################################
#
# File Menu routines
#
# #############################################################################

proc makefileMenuDescription { flag } {
    set fileMenuDescription ""

    lappend fileMenuDescription \
    " \"Image Operations\" 		f.title 		"
    lappend fileMenuDescription \
    " 					f.dblline 		"
    lappend fileMenuDescription \
    " \"Display File Browser\"		f.exec RaiseXDirImages 	"
    lappend fileMenuDescription \
    " \"Load Image\"			f.exec LoadNewImage	"
    lappend fileMenuDescription \
    " \"Save Image\"			f.exec SaveFITS         "
    lappend fileMenuDescription \
    " \"Display FITS Header\"		f.exec DisplayFitsHeader"
    lappend fileMenuDescription \
    "					f.line			"
    lappend fileMenuDescription \
    " \"Send Screen to Printer/File\"	f.exec PrintImage	"
    lappend fileMenuDescription \
    " \"Save Screen to GIF File\"	f.exec SaveGIF 		"
    lappend fileMenuDescription \
    " 					f.line			"
    lappend fileMenuDescription \
    " \"Set Blocking Factor ...\"	f.menu blockingMenu sensitive $flag "
    lappend fileMenuDescription \
    " \"Set Blocking Function ...\"	f.menu blockingFunc sensitive $flag "
    lappend fileMenuDescription \
    "					f.line			"
    lappend fileMenuDescription \
    " \"Reload Current Image\" 		f.exec RedisplayImage sensitive $flag "
    lappend fileMenuDescription \
    " \"Display Full Image (with Autoblock)\"  f.exec DispFullImage sensitive $flag "
    lappend fileMenuDescription \
    " \"Destroy Current Image\"	f.exec DestroyImage sensitive $flag"
    lappend fileMenuDescription \
    " \"Set Max FITS Memory Size\"	f.exec SetMaxSize"
    lappend fileMenuDescription \
    "					f.line			"
    lappend fileMenuDescription \
    " \"Help\"				f.exec ToggleHelp	"
    lappend fileMenuDescription \
    " \"Version\"			f.exec ShowVersion	"
    lappend fileMenuDescription \
    " \"Messages\"			f.exec ToggleMessages	"
    lappend fileMenuDescription \
    " \"Control Panel\"			f.exec panel		"
    lappend fileMenuDescription \
    "					f.line			"
    lappend fileMenuDescription \
    " \"Quit\"				f.exec Quit		"
    return $fileMenuDescription
}
createMenu fileMenu toplevel [makefileMenuDescription True]

proc QuitHelper {{force 0}} {
    global xpafd env
    global warnings

    if { $force || !$warnings } {
	OpenShell
	if { $xpafd != -1 } {
	    puts $xpafd "if ( \$?SAOTNG_XDIR != 0 ) then"
	    puts $xpafd "if ( \"\$SAOTNG_XDIR\" == \"True\" ) then"
	    puts $xpafd "if ( \"`$env(XPAACCESS) XDir`\" == \"yes\" ) then"
	    puts $xpafd "echo 'exit' | $env(XPASET) -w XDir"
	    puts $xpafd "endif"	
	    puts $xpafd "endif"	
	    puts $xpafd "endif"	
	}
	send client Quit
    } else {
	Wexec {QuitHelper 1} "Really quit?"
    }

}

proc Quit args {
    global frameList markers_saved_frame
    global MarkerWarning

    set markers_saved 1
    foreach frame $frameList {
        if { ([info exists markers_saved_frame($frame)] == 0) } {
	    continue
	} elseif { $markers_saved_frame($frame) == 0 } {
	   set markers_saved 0
	}
    }

    if { $MarkerWarning } {
        if { $markers_saved == 1 } {
	    QuitHelper
	} else {
	    Wexec {QuitHelper 1} "Quit without saving markers?"
	}
    } else {
	QuitHelper
    }
}

set imageblocks ""		;# image access blocking factors
set block  0

proc noop args {}

proc SetCurrentSection { param old new } {
    global block
    set block  [lindex $new 0]
    set option [lindex $new 1]
    if { $option == "sum" } {
	set ostr "sum"
    } elseif { $option == "average" } {
	set ostr "avg"
    } else {
	set ostr "?"  
    }
    set nlabel [format "%s/%s" $block $ostr]
    set olabel [send imageLabel get label]
    if { $olabel != $nlabel } {
	send imageLabel set label $nlabel
    }
    editMenu blockingMenu toplevel [makeblockingMenuDescription]
    ReBland  blockingMenu
}; send curroi addCallback SetCurrentSection

# Called when the Selection Position changes
set select_x 0
set select_y 0
proc SetSelectionPos { param old new } {
    global select_x select_y
    set len [llength $new]	
    if { $len != 0 } {
	set select_x [lindex $new 0]
	set select_y [lindex $new 1]
    } else {
	set select_x 0
	set select_y 0
    }
    editMenu blockingMenu toplevel [makeblockingMenuDescription]
    ReBland  blockingMenu
}; send selectpos addCallback SetSelectionPos

# Called when the Section options change.
proc SetSectionList { param old new } {
    global imageblocks
    set imageblocks $new
    editMenu blockingMenu toplevel [makeblockingMenuDescription]
    ReBland  blockingMenu
}; send blocklist addCallback SetSectionList

proc makeblockingMenuDescription args {
    global imageblocks
    set blockingMenuDescription ""

    lappend blockingMenuDescription \
    { "Select Blocking Factor" f.title }
    lappend blockingMenuDescription \
    { f.dblline }

    lappend blockingMenuDescription \
	" \{AutoBlock (display full image)\} f.exec \{ SetBlock auto \}"
    foreach block $imageblocks {
        lappend blockingMenuDescription \
	" \{Block $block\} f.exec \{ SetBlock $block \}"
    }
    lappend blockingMenuDescription \
	    "\"Add New Block\"	f.exec \{ SetBlock new \}"

    return $blockingMenuDescription
}; createMenu blockingMenu toplevel [makeblockingMenuDescription]

createMenu blockingFunc toplevel {
    { "Select Blocking Function"		f.title			}
    {						f.dblline		}
    {  "Block by Summing"			f.exec { SetBlock sum }	}
    {  "Block by Averaging"			f.exec { SetBlock average } }
}

# these variables allow us to transform "set section"
# commands to take the frame's flip state into account
# probably should be dealt with in the client code ...
set ul_flip()  "upper_left"
set ul_flip(x)   "upper_right"
set ul_flip(y)   "lower_left"
set ul_flip(xy)  "lower_right"

set ur_flip()  "upper_right"
set ur_flip(x)   "upper_left"
set ur_flip(y)   "lower_right"
set ur_flip(xy)  "lower_left"

set ll_flip()  "lower_left"
set ll_flip(x)   "lower_right"
set ll_flip(y)   "upper_left"
set ll_flip(xy)  "upper_right"

set lr_flip()  "lower_right"
set lr_flip(x) "lower_left"
set lr_flip(y) "upper_right"
set lr_flip(xy) "upper_left"

proc SetSection { region } {
    global flip ul_flip ur_flip ll_flip lr_flip

    set r $region
    if { $region == "upper_left" } {
	set r $ul_flip($flip)
    } elseif { $region == "upper_right" } {
	set r $ur_flip($flip)
    } elseif { $region == "lower_left" } {
	set r $ll_flip($flip)
    } elseif { $region == "lower_right" } {
	set r $lr_flip($flip)
    }
    SendXPA "section $r"
}

proc SetBlock { block } {
    SendXPA "blocking $block"
}

proc DestroyImageHelper {{force 0}} {
    global markers_saved_frame frame
    global warnings

    if { $force || !$warnings } {
        set markers_saved_frame($frame) 1
        SendXPA "destroy"
    } else {
	Wexec {DestroyImageHelper 1} "Really destroy the image?"
    }
}

proc DestroyImage args {
    global markers_saved_frame frame
    global MarkerWarning

    if { $MarkerWarning } {
        if { ([info exists markers_saved_frame($frame)] == 0) } {
	   DestroyImageHelper
	} elseif {$markers_saved_frame($frame) == 0} {
	   Wexec {DestroyImageHelper 1} "Destroy image without saving markers?"
	} else {
	   DestroyImageHelper
	}
    } else {
	DestroyImageHelper
    }
}

# #############################################################################
#
# "Setup Frame" routines 
#
# #############################################################################

#
# SetCurrentFrame -- called when the "next" frame changes
#
proc SetCurrentFrame { param old new } {
    global frame titleFrame
    global registerFrame
    global frameZoomX frameZoomY frameCenterX frameCenterY
    global frameViews
    global maxcontrast maxContrast contrastsign
    global panzoomvisible
#   global dont_panzoomCursors

    set len [llength $new]
    set frame [lindex $new 0]
    # handle case where this frame was registered to another frame
    # we have to move the cursors to the correct orientation
    if { [info exists registerFrame($frame)] } {
	set panzoomvisible 0
	set rframe [lindex $registerFrame($frame) 0]
	set xflip_change [lindex $registerFrame($frame) 1]
	set yflip_change [lindex $registerFrame($frame) 2]
	flipCursors $xflip_change $yflip_change
#	set dont_panzoomCursors 0
	panzoomCursors "register" "$frameViews($frame)" "$frameViews($rframe)"
	set frameViews($frame) $frameViews($rframe)
	unset registerFrame($frame)
	set panzoomvisible 1
    }
    FrameMlist
    # make sure there is a maxcontrast for this frame
    if { ([info exists maxcontrast($frame)] == 0) } {
        set maxcontrast($frame) $maxContrast
    }
    # make sure there is a contrast sign for this frame
    if { ([info exists contrastsign($frame)] == 0) } {
	set contrastsign($frame) 1
    }
    cpDisplayEnhancement {} {} {}
    set nlabel [format "%s" $frame]
    set olabel [send frameLabel get label]
    if { $olabel != $nlabel } {
	send frameLabel set label $nlabel
    }
    if { ([info exists titleFrame($frame)] == 0) } {
	set titleFrame($frame) " "
    }
    send imageTitle set string $titleFrame($frame)
    send invertButton set on [expr $contrastsign($frame) < 0]
    redisplayMenus
};
send frame addCallback SetCurrentFrame

proc SetFrame { frame } {
    SendXPA "frame $frame"
}


# #############################################################################
#
# Autoconfigure Frame routines 
#
# #############################################################################

set autocf 0
set maxautoconfig ""
set manautoconfig ""

proc SetAutoConfig { param old new } {
    global tileframe blinkId
    global autocf maxautoconfig manautoconfig
    set autocf [lindex $new 0]
    set v1 [lindex $new 1]
    set v2 [lindex $new 2]
    if { ($v1 != 0) && ($v2 != 0) } {
      set maxautoconfig [format "%s %s" $v1 $v2]
    }
    set v1 [lindex $new 3]
    set v2 [lindex $new 4]
    if { ($v1 != 0) && ($v2 != 0) } {
      set manautoconfig [format "%s %s" $v1 $v2]
    }
    editMenu frameMenu toplevel [makeframeMenuDescription]
    ReBland  frameMenu
}; send autoconfig addCallback SetAutoConfig

proc ToggleAutoConfig args {
    global autocf
    if { $autocf >0 } {
	SendXPA "autoconfig False"
    } else {
	SendXPA "autoconfig True"
    }
}

#
# LoadNewConfig -- pop up dialog to load new config parameters
#
set configvalue ""		;# last value returned from this dialog
proc LoadNewConfig args {
    global configvalue manautoconfig
    set configvalue $manautoconfig
    set cmd [format "ReconfigureFrame manual \$configvalue"]
    startDialog "Enter a new width and height for frame 1: " \
		"$cmd" "$configvalue" "configvalue" "xeq"
}

#
# LoadMaxConfig -- pop up dialog to load new max config parameters
#
set maxconfigvalue ""		;# last value returned from this dialog
proc LoadMaxConfig args {
    global maxautoconfig maxconfigvalue
    set maxconfigvalue $maxautoconfig
    set cmd [format "ReconfigureFrame max \$maxconfigvalue"]
    startDialog "Enter a new max width and height for autoconfig: " \
		"$cmd" "$maxconfigvalue" "maxconfigvalue" "xeq"
}

#
# ReconfigureFrame -- reconfigure a frame
#
proc ReconfigureFrame { type {cmd ?} } {
    global frame
    global markers_saved_frame frame
    global MarkerWarning

    if { $frame != 1 } {
	Print \
   "Warning: you can only reconfigure frame #1. Please delete all other frames"
	Print "and try again..."
	return
    }

    if { $cmd == "?" } {
	if { $type == "max" } {
	    LoadMaxConfig
	} else {
	    LoadNewConfig
	}
	return
    }
    SendXPA "autoconfig $type $cmd"
}

# #############################################################################
#
# Current Frame menu routines 
#
# #############################################################################

set frame 1			;# current display frame
set frameList ""		;# current frame buffers
set tileframe 0			;# whether we are tiling
set autotile  0			;# whether we auto switch as mouse moves

proc DeleteFrameHelper {{force 0}} {
    global markers_saved_frame frame
    global warnings

    if { $force || !$warnings } {
	DeleteMarker all
	SetFrame delete
    } else {
	Wexec {DeleteFrameHelper 1} "Really delete frame?"
    }
}

proc DeleteFrame args {
    global markers_saved_frame frame
    global MarkerWarning

    if { $MarkerWarning } {
        if { ([info exists markers_saved_frame($frame)] == 0) } {
	    DeleteFrameHelper
	} elseif {$markers_saved_frame($frame) == 0} {
	    Wexec {DeleteFrameHelper 1} "Delete frame without saving markers?"
	} else {
	    DeleteFrameHelper
	}
    } else {
	DeleteFrameHelper
    }
}

proc createFrame {fn} {
     global markers_saved_frame 

     set markers_saved_frame($fn) 1
     SetFrame new
}

proc makeframeMenuDescription args {
    global frameList titleFrame
    global tileframe blinkId autocf

    set frameMenuDescription ""
    lappend frameMenuDescription {"Set Current Frame:" f.title}
    lappend frameMenuDescription { f.dblline }
    set i 0
    foreach frame $frameList {
	if { ([info exists titleFrame($frame)] == 0) || ($titleFrame($frame) == " ") || ($titleFrame($frame) == "") || ($titleFrame($frame) == "NONE") } {
	    lappend frameMenuDescription \
	       [list "Go to Frame $frame"  "f.exec" "SetFrame $frame"]
	} else {
	    set got [string first "section:" $titleFrame($frame)]
	    if { $got >= 0 } {
		set image [lindex $titleFrame($frame) 1]
		set image2 [lindex $titleFrame($frame) 2]
	        if { [string index $image2 0] == "(" } {
		    set image [list $image $image2]
		}
	    } else {
		set image $titleFrame($frame)
	    }
	    lappend frameMenuDescription \
	       [list "Go to Frame $frame:  $image"  "f.exec" "SetFrame $frame"]
	}
	incr i
    }
    if { $i > 1 } {
        lappend frameMenuDescription \
	    { "Go to Next Frame" f.exec "SetFrame next"}
        lappend frameMenuDescription \
	    { "Go to Previous Frame" f.exec "SetFrame previous"}
        lappend frameMenuDescription \
	    { "Destroy This Frame" f.exec "DeleteFrame" }
    }
    # determine the first free frame number
    set expect 1
    set missing 0
    set lastframe 0
    foreach frame $frameList {
	set lastframe $frame
	if { $frame != $expect } {
	    set missing $expect
	    set expect 0
	    break
	} else {
	    incr expect
	}
    }
    if { $expect != 0 } {
	set missing $expect
    }
    set nf [format "Create New Frame (%d)" $missing]
    lappend frameMenuDescription \
	[list "$nf" "f.exec" "createFrame $missing"]
    lappend frameMenuDescription \
       { "Annotate Frame ..." f.menu annotateMenu }
    lappend frameMenuDescription \
       { f.line }
    if { ($i == 1) && ($lastframe == 1) } {
      lappend frameMenuDescription \
       {"Manually Configure Width and Length of Frame #1" f.exec "ReconfigureFrame manual" }
      lappend frameMenuDescription \
       {"Set the Overall Limit on Autoconfig Width and Length" f.exec "ReconfigureFrame max" }
      lappend frameMenuDescription \
       { {($autocf >0) ? "Disable Autoconfig of Frame #1" : "Enable Autoconfig of Frame #1"} \
	f.exec ToggleAutoConfig }
    } else {
       lappend frameMenuDescription \
       { {$tileframe ? "Stop Tiling" : "Tile Frames"} f.exec toggleTileFrames }
       lappend frameMenuDescription \
       { {$blinkId ? "Stop Blink" : "Blink Frames"} f.exec toggleBlink }
    }

    return $frameMenuDescription
}; createMenu frameMenu toplevel [makeframeMenuDescription]

#
# SetFrameList -- Called when the number of frames changes.
#
proc SetFrameList { param old new } {
    global frameList 
    global tileframe blinkId autocf
    set frameList $new
    editMenu frameMenu toplevel [makeframeMenuDescription]
    ReBland  frameMenu
}; send framelist addCallback SetFrameList


createMenu annotateMenu toplevel {
    {	"Annotate This Frame"	f.title					}
    {				f.dblline				}
    {	"Add Image Filename"	f.exec "createAnnotation filename"	}
    {	"Add Current Date"	f.exec "createAnnotation date"		}
    {	"Add Region Legend"	f.exec "createAnnotation rnames"	}
    {	"Add Your Own Text"	f.exec "createAnnotation text"		}
}

proc createAnnotation { type } {
    global frame xpafd
    global titleFrame 
    global nrname rnames rcolors

    set text ""
    GetTiledWinSize winWidth winHeight sx sy
    set x [expr $winWidth / 2 + $sx]
    set y [expr $winHeight / 2 + $sy]
    switch $type {
      filename {
	if { [info exists titleFrame($frame)] } {
	    set got [string first "section:" $titleFrame($frame)]
	    if { $got >= 0 } {
		set image [lindex $titleFrame($frame) 1]
		set image2 [lindex $titleFrame($frame) 2]
	        if { [string index $image2 0] == "(" } {
		    set image [list $image $image2]
		}
	    } else {
		set image $titleFrame($frame)
	    }
	    set text [format "Image File: %s" $image]
	    CreateTextMarker $text 5 5
	    SetFixParams "zoom"

	} else {
	    Print "Warning: no image filename to annotate"
	    return
	}
      }
      date {
	set text [send client date]
	CreateTextMarker $text 5 20
	SetFixParams "delete zoom"
      }
      rnames {
    	set text "Region Name/Color Associations:"
	for {set i 0} {$i < $nrname} {incr i} {
	    set name [format "%s:" $rnames($i)]
	    set text [format "%s\n%-24s    %s" $text $name $rcolors($i)]
	}
	CreateTextMarker $text 5 35
	SetFixParams "delete zoom"
      }
      text {
	CreateTextMarker ? 5 80
      }
    }
}

# #############################################################################
#
# Scale Menu routines  
#
# #############################################################################

#
# SetScaleLimits -- send XPA call to load new scaling limits
#
proc SetScaleLimits { cmd } {
    # send the command
    SendXPA "scalelims $cmd"
}

proc DisplayScaleLimits args {
    global xpa xpafd env

    OpenShell
    if { $xpafd == -1 } {
	return
    }
    puts $xpafd "$env(XPAGET) $xpa scalelims |& $env(XPASET) $xpa message 'Scaling Limits: '"
    flush $xpafd
    MessDisplay
}

#
# LoadScaleLimits -- pop up dialog to load new scale limits
#
set scalelims ""		;# last value returned from this dialog
proc LoadScaleLimits args {
    global scalelims

    set cmd [format "SetScaleLimits \$scalelims"]
    startDialog "Enter new min and max scaling values: " \
		"$cmd" "$scalelims" "scalelims" "xeq"
}

createMenu scalelimsMenu toplevel {
    {"Scaling Limits (Min/Max) For This Frame"	f.title			}
    {					f.dblline			}
    {"Get Limits From Data"		f.exec "SetScaleLimits data"	}
    {"Use IRAF ZScale Algorithm"	f.exec "SetScaleLimits zscale"	}
    {"Manually Set Min/Max Limits"	f.exec "LoadScaleLimits"	}
    {					f.line				}
    {"Display Current Limits"		f.exec "DisplayScaleLimits"	}
}

proc SetCurrentScale { param old new } {
    set nlabel $new
    set olabel [send scaleLabel get label]
    if { $olabel != $nlabel } {
	send scaleLabel set label $new
    }
}; send curscale addCallback SetCurrentScale

proc SetScaleList { param old new } {
    set i 0
    lappend itemList {"Set Scale For This Frame:" f.title}
    lappend itemList { f.dblline }
    foreach item $new {
        set name [lindex $item 0]
        set scale [lindex $item 1]
        lappend itemList " \{ $name \} f.exec \{ SetScale $scale \}"
        incr i
    }
    lappend itemList \
       { " Set Min/Max For Scaling ..." f.menu scalelimsMenu }
    editMenu scaleMenu toplevel $itemList
    ReBland  scaleMenu
}; send scalelist addCallback SetScaleList

proc SetScale { scale } {
    SendXPA "scale $scale"
    SetCurrentScale "dummy1" "dummy2" $scale
}

#
# routines dealing with the marking of the colorbar with sample scale values
#
set nscalemarkers 0
set scalemarker_color "cyan"

# translations for the scale markers
set scaleMarkerTranslations { \
	   <Btn1Down>:  call(noop)
	Any<Btn3Down>:	popup(scaleMarkerMenu,$x,$y)
	  Any<Btn3Up>:	popdown(scaleMarkerMenu)
}

createMenu scaleMarkerMenu toplevel {
    {	"Scale Marker Color"	f.title					}
    {			f.dblline				}
    {	Black		f.exec "SetScaleMarkerColor black"	}
    {	White		f.exec "SetScaleMarkerColor white"	}
    {	Red		f.exec "SetScaleMarkerColor red"	}
    {	Green		f.exec "SetScaleMarkerColor green"	}
    {	Blue		f.exec "SetScaleMarkerColor blue"	}
    {	Cyan		f.exec "SetScaleMarkerColor cyan"	}
    {	Yellow		f.exec "SetScaleMarkerColor yellow"	}
    {	Magenta		f.exec "SetScaleMarkerColor magenta"	}
}

proc SetScaleMarkerColor { color } {
    global nscalemarkers scalemarker_color

    for {set i 1} {$i <= $nscalemarkers} {incr i} {
	set sm [format "scalemarker%s" $i]
	set err [catch { set region [send $sm getPreciseRegion] }]
	if { $err == 0 } {
	    m_setColor $color $sm
	}
    }
    set scalemarker_color $color   
}

proc UnsetScaleSamples args {
    global nscalemarkers

    send scaleSamples set string " "
    for {set i 1} {$i <= $nscalemarkers} {incr i} {
	set sm [format "scalemarker%s" $i]
	set err [catch { set region [send $sm getPreciseRegion] }]
	if { $err == 0 } {
	    send $sm destroy
	}
    }
    set nscalemarkers 0
}

proc SetScaleSamples { param old new } {
    global winWidth
    global nscalemarkers scalemarker_color scaleMarkerTranslations
    global MarkerFont

    # start with a clean slate ...
    UnsetScaleSamples
    # if we have samples ...
    if { $new != "" } {
	# we assume there always are 200 colors, as specified in iis.c
	set scalefactor [expr double($winWidth) / 200.0]
	set s "   scale legend: "
	set n [expr [lindex $new 0] * 2]
	set lastpos -100
	set lastj 1
        for {set i 1} {$i <= $n} {incr i 2} {
	    set j [expr ($i + 1)/2]
	    set pos [expr double([lindex $new [expr $i + 1]]) * $scalefactor]
	    # make sure the last one can be viewed
	    if { [expr $winWidth - $pos] <= 10 } {
		set pos [expr $pos - (10 - ($winWidth - $pos)) ]
	    }
	    if { [expr $pos - $lastpos] < 3 } {
	        set s [format "%s %s(%s)~%s " $s $j [lindex $new $i] $lastj]
		continue
	    } else {
		set s [format "%s %s=%s " $s $j [lindex $new $i]]
		set lastj $j
	        set lastpos $pos
	    }
	    send colorbar createMarker [format "scalemarker%s" $j] \
	    type		text \
	    translations	$scaleMarkerTranslations \
	    text		[format "%s" $j] \
	    font		$MarkerFont \
	    textFont		$MarkerFont \
	    markerTextFont	$MarkerFont \
	    width		1ch \
	    height		1ch \
	    x			$pos \
	    y			1 \
	    lineWidth		0 \
	    imageText		false \
	    textColor		$scalemarker_color \
            activated           True \
            sensitive           True \
	    visible		True

	}
	send scaleSamples set string $s
	set nscalemarkers $j
    }
}; send scalesamples addCallback SetScaleSamples

# #############################################################################
#
#  Colormap Menu routines
#
# #############################################################################

proc SetCurrentColor { param old new } {
    global colormap contrastsign maxContrast maxcontrast frame

    set cmap [lindex $new 0]
    if { $cmap == "Grayscale" } {
        set cmap "Grey"
    }
    set i [string first "(discrete)" $cmap]
    if { $i != -1 } {
	set cmap [format "%s*" [string range $cmap 0 [expr $i - 1]]]
    }

    set nlabel [format "%.6s" $cmap]
    set olabel [send colorLabel get label]
    if { $olabel != $nlabel } {
	send colorLabel set label $nlabel
    }

    # save the colormap for this frame
    if { ([info exists colormap($frame)] == 0) } {
	set oldcmap ""
    } else {
        set oldcmap $colormap($frame)
    }
    # save the contrast sign for this frame
    if { ([info exists contrastsign($frame)] == 0) } {
	set contrastsign($frame) 1
    }
#    # if this is a new colormap for this frame, reset things
    if { $oldcmap != $cmap } {
        # reset the max contrast
        set maxcontrast($frame) $maxContrast
        # reset the invert flag
        set contrastsign($frame) 1
    }
    set colormap($frame) $cmap
#   deal with discrete colormaps  ... some things are not implemented ...
    set flag True
    if { $param == "curcolor" } {
	if { [llength $new] > 1 } {
	    if { [lindex $new 1] > 0 } {
	        set flag False
	    }
	}
    }
    if { $flag } {
	send colordata2 set sensitive True
        send contrastSlider map
        send maxcontrastSlider map
    } else {
	send colordata2 set sensitive False
        send contrastSlider unmap
        send maxcontrastSlider unmap
    }
    send invertButton set sensitive $flag
    send invertButton set on [expr $contrastsign($frame) < 0]
    editMenu colorMenu toplevel [makeColorList $flag]
    ReBland  colorMenu
}; send curcolor addCallback SetCurrentColor

proc makeColorList { flag } \
{
    global colorlist

    set i 0
    lappend itemList {"Set Colormap For This Frame:" f.title}
    lappend itemList { f.dblline }
    foreach color $colorlist {
        set name $color
        if { $name == "Grayscale" } {
 	    set name "Gray"
        }
	if { $name == "f.line" } {
            lappend itemList { f.line }
        } else {
            lappend itemList "\"$name\" f.exec \{ SetColormap \"$color\" \}"
        }
        incr i
    }
    lappend itemList { f.line }
    lappend itemList "\"Invert Colormap\" f.exec \{ cpInvert \} sensitive $flag"
    lappend itemList { f.dblline }
    lappend itemList { "GUI Color Schemes ..." f.menu blandMenu }
}

set colorlist ""
proc SetColorList { param old new } {
    global colorlist
    set colorlist $new
    editMenu colorMenu toplevel [makeColorList True]
    ReBland  colorMenu
    SetCurrentColor $param $old $new
}; send cmaps addCallback SetColorList

# change the colormap
proc SetColormap cmap \
{
    SendXPA "colormap $cmap"
}

# #############################################################################
#
#  Routines dealing with the flavor of the GUI
#
# #############################################################################

createMenu blandMenu toplevel {
    {"Choose a color scheme for SAOtng ..."       f.title }
    {                        f.dblline                       }
    {"Make the GUI Colors Very Bland"	f.exec "ReFlavor gui ? BLAND"}
    {"Make the GUI Colors Traditional"	f.exec "ReFlavor gui ? DEFAULT"}
    {"Make the GUI Colors Beautiful"	f.exec "ReFlavor gui ? BEAUTIFUL"}
}
# we need this in case the colors are really messed up and the user can't
# see the menus at all -- at least (s)he can find the menu to make things bland
send blandMenu set background white

proc ReFlavor { param old new } {
    global env
    global curAccelCmds
    global CurMAnalCmds
    global accelColors
    global BackgroundColor DialogColor
    global MenuBackground MenuForeground
    global CommandBackground CommandForeground
    global xpafd

    set env(SAORD_GUIFLAVOR) [string toupper $new]
    SAOtngFlavor

    if { $env(SAORD_GUIFLAVOR) == "BLAND" } {
	set BC white
	set DC white
	set CB white
	set MB white
	set MF black
	set AC bland
    } elseif { $env(SAORD_GUIFLAVOR) == "BEAUTIFUL" } {
	set BC $BackgroundColor
	set DC $DialogColor
	set CB $CommandBackground
	set MB $MenuBackground
	set MF $MenuForeground
	set AC multi
    } else {
	set BC $BackgroundColor
	set DC $DialogColor
	set CB $CommandBackground
	set MB $MenuBackground
	set MF $MenuForeground
	set AC $BackgroundColor
    }

    send controlPanel set background $BC
    send viewBox set background $BC
    send wcsBox set background $BC
    send enhancementBox set background $BC
    send blinkBox set background $BC
    send optionsBox set background $BC
    send controlBox set background $BC
 
    send view set background $BC
    send frameSelect set background $BC
    send frameBox set background $BC
    send frameDataBox set background $BC
    send frameData set background $BC
    send frame1 set background $BC
    send frame2 set background $BC
    send frame3 set background $BC
    send frame4 set background $BC
    send prevFrame set background $CB
    send nextFrame set background $CB
    send zoomBox set background $BC
    send zoomLayout set background $BC
    send zoomOut set background $BC
    send centerFrame set background $BC
    send toggleZoom set background $BC
    send zoomIn set background $BC
    send viewButtons set background $BC
    send aspect set background $BC
    send flipX set background $BC
    send flipY set background $BC
    send flipXY set background $BC
    send clearframe set background $BC
    send fitframe set background $BC
 
    send x1 set background $CB
    send z2 set background $CB
    send z2 set background $CB
    send z3 set background $CB
    send z4 set background $CB
    send z5 set background $CB
    send z8 set background $CB
    send d2 set background $CB
    send d2 set background $CB
    send d3 set background $CB
    send d4 set background $CB
    send d5 set background $CB
    send d8 set background $CB

    send z2 set foreground white
    send z3 set foreground white
    send z4 set foreground white
    send z5 set foreground white
    send z8 set foreground white

    send blinkFrame1 set background $CB
    send blinkFrame2 set background $CB
    send blinkFrame3 set background $CB
    send blinkFrame4 set background $CB

    send wcstext set background $BC
 
    send blink set background $BC
    send blinkFramesLabel set background $BC
    send blinkRateLabel set background $BC
    send blinkReset set background $BC
    send BRframe set background $BC
    send BRlayout set background $BC
    send BRdecrease set background $BC
    send BRtext set background $BC
    send BRincrease set background $BC
    send registerButton set background $BC
    send matchButton set background $BC
    send blinkButton set background $BC

    send enhance set background $BC
    send colorlistScroll set background $BC
    send colorlistFrame set background $BC
    send colorlistPort set background $BC
    send colorlist set background $BC
    send colordataFrame set background $BC
    send colordataLayout set background $BC
    send colordata set background $BC
    send colordata2 set background $BC
    send contrastLabel set background $BC
    send contrastSlider set background $BC
    send maxcontrastLabel set background $BC
    send maxcontrastSlider set background $BC
    send brightnessLabel set background $BC
    send brightnessSlider set background $BC
    send invertButton set background $BC
 
    send pannerButton set background $BC
    send magnifierButton set background $BC
    send coordsBoxButton set background $BC
    send tileFramesButton set background $BC
    send autoTileButton set background $BC
    send autoscaleButton set background $BC
    send antialiasButton set background $BC
    send warningsButton set background $BC
 
    send control set background $BC
    send initializeButton set background $BC
    send normalizeButton set background $BC
    send doneButton set background $BC
 
    send helpLay set background $BC
    send helpFrame set background $BC
    send nexturlLabel set background $BC
    send helpReset set background $BC
    send helpBack set background $BC
    send helpForw set background $BC
    send helpDone set background $BC
    send helpLabel set background $BC
    send messClear set background $BC
    send messDone set background $BC

    send warn set background $BC
    send warnFrame set background $BC
    send WFlayout set background $BC
    send warnText set background $BC
    send warnOk set background $BC
    send warnCancel set background $BC
 
    send dialog set background $BC
    send dialogOk set background $BC
    send dialogClear set background $BC
    send dialogCancel set background $BC
    send dialogLabel set background $BC
    send dialogValue set background $DC
    send dialogIcon set background $BC
    send dialogFrame set background $BC

    send topForm set background $BC
    send menuForm set background $BC
    send imageForm set background $BC
    send infoForm set background $BC
    send scaleSamples set background $BC
 
    send imageButton set background $MB
    send coordsButton set background $MB
    send frameButton set background $MB
    send scaleButton set background $MB
    send colorButton set background $MB
    send markerButton set background $MB
    send zoomButton set background $MB
    send analButton set background $MB
 
    send imageButton set foreground $MF
    send coordsButton set foreground $MF
    send frameButton set foreground $MF
    send scaleButton set foreground $MF
    send colorButton set foreground $MF
    send markerButton set foreground $MF
    send zoomButton set foreground $MF
    send analButton set foreground $MF
 
    send imageLabel set background $BC
    send coordsLabel set background $BC
    send frameLabel set background $BC
    send scaleLabel set background $BC
    send colorLabel set background $BC
    send markerLabel set background $BC
    send analLabel set background $BC
    send zoomLabel set background $BC
 
    if { $CurMAnalCmds >= 0 } {
      send markerMenu set background $BC
      send markerType set background $BC
      send markerColor set background $BC
      send markerShape set background $BC
      send markerIE set background $BC
      send markerAnalMenu set background $BC
      send textMarkerMenu set background $BC
    }

    send fileMenu set background $BC
    send colorMenu set background $BC
    send blockingMenu set background $BC
    send blockingFunc set background $BC
    send scaleMenu set background $BC
    send frameMenu set background $BC
    send scaleMarkerMenu set background $BC
#   send blandMenu set background $BC
    send cursorMenu set background $BC
    send regionShapeMenu set background $BC
    send regionNameMenu set background $BC
    send regionColorMenu set background $BC
    send panMenu set background $BC
    send panmagMenu set background $BC
    send panmagMenu2 set background $BC
    send magzoomMenu set background $BC
    send analMenu set background $BC
    send wcsMenu set background $BC
    send wcsColorMenu set background $BC
    send wcsSysMenu set background $BC
    send annotateMenu set background $BC
    send scalelimsMenu set background $BC

    send aV set background $BC
    send aF set background $BC
    NewAccelColors $param ? $AC
 
    send imageTitle set background $BC
    send messLabel set background $BC
#   send messLine set background $BC
    send messFrame set background $BC
    send messLay set background $BC
    send messClear set background $BC
    send messDone set background $BC

    send helpButton set background $BC
    # try to reflavor xtext and xdir windows as well
    OpenShell
    if { $xpafd !=  -1 } {
	puts $xpafd "echo \"flavor $env(SAORD_GUIFLAVOR)\" | $env(XPASET) XDir"
	puts $xpafd "echo \"flavor $env(SAORD_GUIFLAVOR)\" | $env(XPASET) XText"
	if { [info exists env(SAOTNG_REFLAVOR)] } {
	    puts $xpafd "$env(SAOTNG_REFLAVOR)"
	}
	flush $xpafd
    }
}

# when we edit a menu, we have to redo the colors because edit resets them.
proc ReBland { menu } \
{
    global env BackgroundColor

    if { $env(SAORD_GUIFLAVOR) == "BLAND" } {
	set color white
    } else {
	set color $BackgroundColor
    }
    send $menu set background $color
}

# #############################################################################
#
# Cursor Menu routines 
#
# #############################################################################


set mtype "none"

createMenu cursorMenu toplevel {
    { "Marker Options:" f.title }
    { f.dblline }
    {	"Set Default Marker Shape ..."	f.menu regionShapeMenu	}
    {	"Set Default Marker Name (and Color) ..." f.menu regionNameMenu	}
    {	"Set Default Marker Color ..."	f.menu regionColorMenu	}
    {   "Oops! Restore Deleted Marker"	f.exec "UndeleteMarker"	}
    {    				f.line			}
    {   "Load Markers"		 	f.exec LoadRegions      }
    {	"Save Markers"			f.exec SaveRegions	}
    {	"List Markers"			f.exec ViewMlist	}
    {	"Refresh Markers"		f.exec FrameMlist	}
    {	"Delete Markers"		f.exec "DeleteAllMarkers" }
    {    				f.line				}
    {   "Display Current Name/Color Association" f.exec DisplayRNames	}
    {   "Edit Name/Color Association"	f.exec LoadNewRNames		}
    {   "Display Valid Marker Colors"	f.exec DisplayColors		}
    {   "Update Markers To Current Colors" f.exec "ReColorMlist color"	}
    {   "Update Markers To Current Names" f.exec "ReColorMlist name"	}
    {    				f.line				}
    {	"Display Global Fix Params For New Markers" \
				f.exec {DisplayFixParams global} 	}
    {	"Edit Global Fix Params For New Markers" f.exec {NewFixParams}	}
    {	"Fix Current Markers Using Global Fix Params"	\
				f.exec {FixMarkers "?" "?" "cur cur" }	}
    {	"Free Current Markers"	f.exec {FixMarkers "?" "?" "cur none"}	}
    {    				f.line			}
    {	"Toggle All Text Displays"	f.exec ToggleTextMlist	}
    {	"Toggle All Text Backgrounds" 	f.exec ToggleImageText	}
    {    				f.line			}
    { 	"Display File Browser"		f.exec RaiseXDirMarkers }
}

createMenu regionShapeMenu toplevel {
    {	"Select Marker Shape"		f.title				}
    {					f.dblline			}
    {	Circle				f.exec "SetMarkerType circle"	}
    {	Ellipse				f.exec "SetMarkerType ellipse"	}
    {	Line				f.exec "SetMarkerType line"	}
    {	Point				f.exec "SetMarkerType point"	}
    {	Polygon				f.exec "SetMarkerType polygon"	}
    {	Rectangle			f.exec "SetMarkerType rectangle"}
    {   Text				f.exec 	DefTextMarker 		}
}

createMenu regionColorMenu toplevel {
    {	"Select Default Marker Color"	f.title				}
    {					f.dblline			}
    {	Black				f.exec "set DefaultColor black"	}
    {	White				f.exec "set DefaultColor white"	}
    {	Red				f.exec "set DefaultColor red" 	}
    {	Green				f.exec "set DefaultColor green"	}
    {	Blue				f.exec "set DefaultColor blue" 	}
    {	Cyan				f.exec "set DefaultColor cyan" 	}
    {	Yellow				f.exec "set DefaultColor yellow" }
    {	Magenta				f.exec "set DefaultColor magenta" }
}

# make the region name menu
proc makeRnameMenu args {
    global nrname rnames rcolors

    set rnameMenuDescription ""
    lappend rnameMenuDescription \
    " \"Select Default Marker Type and Color\"	f.title"
    lappend rnameMenuDescription \
    " 						f.dblline"
    for {set i 0} {$i < $nrname} {incr i} {
        lappend rnameMenuDescription \
	" \{$rnames($i) ($rcolors($i))\} f.exec \{ 
		set DefaultColor $rcolors($i) \}"
    }
    return $rnameMenuDescription
}

# Sets type of marker to create
proc SetMarkerType { type } \
{
        global mtype
	set mtype $type
	set name $mtype
	if { $name == "rectangle" } {
	    set name "rect"
	}
#	if { $name == "ellipse" } {
#	    set name "ellip"
#	} elseif { $name == "polygon" } {
#	    set name "poly"
#	}
	set nlabel $name
	set olabel [send markerLabel get label]
	if { $olabel != $nlabel } {
	    send markerLabel set label $nlabel
	}
}

SetMarkerType $DefaultMarker

# #############################################################################
#
# Pan/Zoom Menu routines  
#
# #############################################################################

set panner_enable 0
set magnifier_enable 0

set xmag 1
set ymag 1
set flip ""
set xflip 0
set yflip 0
set last_zstr ""
set autofl 0

proc SetAutoflip { param old new } {
    global autofl
    set autofl [true $new]
    editMenu panMenu toplevel [makepanMenuDescription]
    ReBland  panMenu
}; send autoflip addCallback SetAutoflip

proc ToggleAutoFlip args {
    global autofl
    if { $autofl } {
	SendXPA "autoflip False"
    } else {
	SendXPA "autoflip True"
    }
}

#
# SetCurrentPan -- called when the pan label needs to change
#
proc SetCurrentPan { param old new } {
    global xmag ymag flip xflip yflip
    global frame panFrame flipFrame
    global frameSX frameSY frameSNX frameSNY
    global winWidth winHeight
    global last_zstr

    set panFrame($frame) $new
    set mag [split [lindex $new 0] ,]
    set xmag [lindex $mag 0]
    set ymag [lindex $mag 1]
    set flip [lindex $new 1]
    set flipit [lindex $new 2]
    set xflip [expr [string first x $flip] >= 0]
    set yflip [expr [string first y $flip] >= 0]
    set flipFrame($frame) [list $xflip $yflip]
    if { $ymag == "" } {
       set mstr [format "%.3g" [expr 0.0 + $xmag]]
    } else {
       set mstr [format "%.3g/%.3g" [expr 0.0 + $xmag] [expr 0.0 + $ymag]]
    }
    if { $flip == "" } {
       set zstr $mstr
    } else {
       set zstr [format "%s/%s" $mstr $flip]
    }
    set llen [string length $zstr]
#    if { $llen <= 2 } {
#       set zstr [format "   %s" $zstr]
#    } elseif { $llen <= 4 } {
#       set zstr [format "  %s" $zstr]
#    } elseif { $llen <= 6 } {
#       set zstr [format " %s" $zstr]
#    }
    if { $last_zstr != $zstr } {
	send zoomLabel set label $zstr
    }
    set last_zstr $zstr
    set oldflip [lindex $old 1]
    set oldxflip [expr [string first x $oldflip] >= 0]
    set oldyflip [expr [string first y $oldflip] >= 0]
    set xflip_change [expr $xflip != $oldxflip]
    set yflip_change [expr $yflip != $oldyflip]
    if {$xflip_change || $yflip_change} {
	pannerMapImage
	set fR [format "%d %d %d %d %d" $frame \
		$frameSX($frame) $frameSY($frame) \
		$frameSNX($frame) $frameSNY($frame)]
	pannerSetRegion "SetCurrentPan" $fR $fR

	#### This is not a good way to position it.
	magnifierMapImage [expr $winWidth / 2] [expr $winHeight / 2]

	if { $flipit } {
	    flipCursors $xflip_change $yflip_change
	}
    }
}; send curpan addCallback SetCurrentPan

#
# LoadPanZoom -- pop up dialog to load pan/zoom parameters
#
set panzoomvalue ""		;# last value returned from this dialog
proc LoadPanZoom args {
    global frameZoomX frameZoomY frameCenterX frameCenterY frame
    global panzoomvalue
    set panf [format "%s %s" $frameCenterX($frame) $frameCenterY($frame)]
    if { $frameZoomX($frame) == $frameZoomY($frame) } {
      set zoomf [format "%s" $frameZoomX($frame)]
    } else {
      set zoomf [format "%s %s" $frameZoomX($frame) $frameZoomY($frame)]
    }
    set panzoomvalue [format "%s %s" $panf $zoomf]
    set cmd [format "SetPanZoom \$panzoomvalue"]
    startDialog "Enter x y pan values and optional zoom(s): " \
		"$cmd" "$panzoomvalue" "panzoomvalue" "xeq"
}

#
# SetPanZoom -- set pan and optional zoom values
#
proc SetPanZoom { s } {
    switch [llength $s] {
    0 {
	Print "Warning: requires 2 pan arguments"
	MessDisplay
      }
    1 {
	Print "Warning: requires 2 pan arguments"
	MessDisplay
      }
    2 {
	SetPan $s	
      }
    3 {
	SetPan "image [lindex $s 0] [lindex $s 1]"
	SetZoom "[lindex $s 2]"
      }
    4 {
	SetPan "image [lindex $s 0] [lindex $s 1]"
	SetZoom "[lindex $s 2] [lindex $s 3]"
      }
    default {
	SetPan "image [lindex $s 0] [lindex $s 1]"
	SetZoom "[lindex $s 2] [lindex $s 3]"
      }
    }    
}

# display pan and zoom values for this frame
proc PrintPanZoom args {
  global frameZoomX frameZoomY frameCenterX frameCenterY
  global frame
  Print [format "Pan and Zoom values for frame: %s" $frame]
  Print [format "pan: %s %s" $frameCenterX($frame) $frameCenterY($frame)]
  if { $frameZoomX($frame) == $frameZoomY($frame) } {
    Print [format "zoom: %s" $frameZoomX($frame)]
  } else {
    Print [format "zoom: %s %s" $frameZoomX($frame) $frameZoomY($frame)]
  }
  MessDisplay
}

# change the zoom
proc SetZoom { zoom } \
{
	SendXPA "zoom $zoom"
}

proc SetFlip { flip } \
{
	SendXPA "flip $flip"
}

proc SetPan { pan } \
{
	SendXPA "pan $pan"
}

proc makepanMenuDescription args {
    global autofl

    set panMenuDescription ""
    lappend panMenuDescription \
    { "Flip, Zoom, and Pan This Frame" f.title }
    lappend panMenuDescription \
    { f.dblline }
    lappend panMenuDescription \
    {   "Flip By X"			f.exec {SetFlip "x"} }
    lappend panMenuDescription \
    {   "Flip By Y"			f.exec {SetFlip "y"} }
    lappend panMenuDescription \
    {   "Flip By X & Y"			f.exec {SetFlip "xy"} }
    lappend panMenuDescription \
    {   f.line }	
    lappend panMenuDescription \
    {	"Set Zoom Factor to 1"		f.exec {SetZoom "abs 1"} }
    lappend panMenuDescription \
    {	"Set Zoom Factor to 2"		f.exec {SetZoom "abs 2"} }
    lappend panMenuDescription \
    {	"Set Zoom Factor to 4"		f.exec {SetZoom "abs 4"} }
    lappend panMenuDescription \
    {	"Current Zoom x 2"		f.exec {SetZoom "rel 2"} }
    lappend panMenuDescription \
    {	"Current Zoom x 4"		f.exec {SetZoom "rel 4"} }
    lappend panMenuDescription \
    {   "Current Zoom x 1/2"            f.exec {SetZoom "rel 0.5"} }
    lappend panMenuDescription \
    {   "Current Zoom x 1/4"            f.exec {SetZoom "rel 0.25"} }
    lappend panMenuDescription \
    {	"Recenter at Current Zoom"	f.exec {SetZoom "center"} }
    lappend panMenuDescription \
    {	"Reset and Recenter Zoom"	f.exec {SetZoom "reset"} }
    lappend panMenuDescription \
    {"Manually Set Pan (and Zoom)" 	f.exec "LoadPanZoom" }
    lappend panMenuDescription \
    {	"Print Pan/Zoom"		f.exec {PrintPanZoom} }
    lappend panMenuDescription \
    {   f.line }	
    lappend panMenuDescription \
        { {$autofl ? "Disable Auto-Flip" : "Enable Auto-Flip"} \
	f.exec ToggleAutoFlip }
    lappend panMenuDescription \
    {	"Panner/Magnifier Options ..."	f.menu panmagMenu }
    return $panMenuDescription
}
editMenu panMenu toplevel [makepanMenuDescription]

createMenu panmagMenu toplevel {
    {	"Panner/Magnifier"		f.title				}
    {					f.dblline			}
    {	"Toggle Panner"			f.exec "togglePanner"		}
    {	"Toggle Magnifier"		f.exec "toggleMagnifier"	}
    {	"Display Neither"		f.exec "SetPanMag none"		}
    {	f.line								}
    {	"Set Panner/Magnifier Color ..." f.menu "panmagMenu2"	}
    {	"Set Magnifier Zoom ..."	f.menu "magzoomMenu"	}
    {	"Toggle Magnifier Marker"  	f.exec "toggleMagPointer" 	}
}

createMenu panmagMenu2 toplevel {
    {	"Panner/Magnifier Color"	f.title		}
    {			f.dblline			}
    {	Black		f.exec "SetPanMagColor black"	}
    {	White		f.exec "SetPanMagColor white"	}
    {	Red		f.exec "SetPanMagColor red"	}
    {	Green		f.exec "SetPanMagColor green"	}
    {	Blue		f.exec "SetPanMagColor blue"	}
    {	Cyan		f.exec "SetPanMagColor cyan"	}
    {	Yellow		f.exec "SetPanMagColor yellow"	}
    {	Magenta		f.exec "SetPanMagColor magenta"	}
}
createMenu magzoomMenu toplevel {
    {	"Magnifier Zoom Factors"	f.title				}
    {					f.dblline			}
    {	"Zoom 1"			f.exec "setMagnifierZoom 1"	}
    {	"Zoom 2"			f.exec "setMagnifierZoom 2"	}
    {	"Zoom 4"			f.exec "setMagnifierZoom 4"	}
    {	"Zoom 8"			f.exec "setMagnifierZoom 8"	}
    {	"Zoom 16"			f.exec "setMagnifierZoom 16"	}
}

# #############################################################################
#
# Analysis Menu routines  
#
# #############################################################################

proc SetAnalList { param old new } {
    global AnalFormat
    global viewFrame frame

    # if an IRAF image is loaded, there are no anal tasks here
    if { [info exists viewFrame($frame)] } {
	if { $viewFrame($frame) == 0 } {
	    send analButton set sensitive False
	    send analLabel set sensitive False
	    return
	}
    }

    if { $new != "NONE" } {
        lappend itemList {"Run Analysis Task:" f.title}
        lappend itemList { f.dblline }
#	set alist [lsort $new]
	set alist $new
	# see how many different sources we have
	set lastfile ""
	set nfiles 0
        foreach entry $alist {
	    set file [lindex $entry 0]
	    if { $lastfile != $file } {
		incr nfiles
	    }
	    set lastfile $file
	}
	# for 1 source, just make a list ...
	if { ($nfiles == 1) || ($AnalFormat == "none") } {
	    set nfiles 0
	    set ncmds 0
	    foreach entry $alist {
		set file [lindex $entry 0]
		set anal [lindex $entry 1]
		if { $anal == "f.line" } {
		    lappend itemList "f.line"
		} elseif { $anal == "f.dblline" } {
		    lappend itemList "f.dblline"
		} else {
		    lappend itemList "\{$anal\} f.exec \{ RunAnal $ncmds \}"
		}
		incr ncmds
	    }
	} elseif { $AnalFormat == "line" } {
	    set lastfile ""
	    set nfiles 0
	    set ncmds 0
	    foreach entry $alist {
		set file [lindex $entry 0]
		set anal [lindex $entry 1]
		if { $lastfile != $file } {
		    if { $nfiles != 0 } {
			lappend itemList "f.line"
		    }
		    incr nfiles
		}
		if { $anal == "f.line" } {
		    lappend itemList "f.line"
		} elseif { $anal == "f.dblline" } {
		    lappend itemList "f.dblline"
		} else {
		    lappend itemList "\{$anal\} f.exec \{ RunAnal $ncmds \}"
		}
		set lastfile $file
		incr ncmds
	    }
        } else {
	    set AnalFormat "submenu"
	    set lastfile ""
	    set nfiles 0
	    set ncmds 0
	    foreach entry $alist {
		set file [lindex $entry 0]
		set idx [string last "/" $file]
		if { $idx >= 0 } {
		    set name [string range $file [expr $idx + 1] end]
		} else {
		    set name $file
		}
		# look for duplicate of file name and make unique if so
		for {set i 1} {$i <= $nfiles} {incr i} {
		    if { $name == $AnalFile($i) } {
			if { $name != $file } {
			    set name $file
			} else {
			    set name [format "%s%s" $name [expr $nfiles + 1]]
			}
			break
		    }
		}
		set anal [lindex $entry 1]
		if { $lastfile != $file } {
		    incr nfiles
		    lappend itemList "\{$name ...\} f.menu AnalMenu$nfiles"
		    set AnalFile($nfiles) $name
		    set AnalList($nfiles) "" 
		    set lastfile $file
		}
		if { $anal == "f.line" } {
		    lappend AnalList($nfiles) "f.line"
		} elseif { $anal == "f.dblline" } {
		    lappend AnalList($nfiles) "f.dblline"
		} else {
		    lappend AnalList($nfiles) "\{$anal\} f.exec \{ RunAnal $ncmds \}"
		}
		incr ncmds
	    }
	}
    } else {
        lappend itemList {"No Analysis Tasks For Current Image!" f.title}
	set nfiles 0
	set ncmds 0
    }
    editMenu analMenu toplevel $itemList
    ReBland  analMenu
    # add sub-menus if necessary 
    if { ($nfiles > 1) && ($AnalFormat == "submenu") } {
	# edit the menus
	for {set j 1} {$j <= $nfiles} {incr j} {
	    if { $AnalList($j) != "" } {
	        editMenu AnalMenu$j toplevel $AnalList($j)
	        ReBland  AnalMenu$j
	    }
	    if { [info procs AnalMenu$j] == "" } {
		eval "proc AnalMenu$j args {}"
	    }
	}		
    }
    if { $ncmds > 0 } {
	send analButton set sensitive True
	send analLabel set sensitive True
    } else {
	send analButton set sensitive False
	send analLabel set sensitive False
    }
}; send anallist addCallback SetAnalList

createMenu analMenu toplevel {
    { "No Analysis Tasks For Current Image!" f.title }
}

proc RunAnal { n } {
    SendXPA "analysis $n"
}

proc IdleCursor args {
    send imagewin setCursorType idle
}

proc BusyCursor args {
    send imagewin setCursorType busy
}

# #############################################################################
#
# Marker Analysis Menu routines  
#
# #############################################################################

set markanallist ""
set nmarkanal 0
set CurMAnalCmds -1

proc SetMarkerAnalList { param old new } {
    global markanallist
    global manalhelp manalreg nmarkanal

    if { [string range $new 0 11] == "*REFERENCE*\n" } {
	set list [split [string range $new 12 end] \n]
	set n [expr [llength $list] - 1]
	set nmarkanal 0
	for {set i 0} {$i < $n} {incr i 5} {
	    set manalhelp($nmarkanal) [lindex $list [expr $i + 0]]
	    set manalreg($nmarkanal) [lindex $list [expr $i + 2]]	
	    incr nmarkanal
	}
    } else { 
	set markanallist $new
    }
}; send manallist addCallback SetMarkerAnalList


proc EditMarkerAnalMenu args {
    global marker markanallist
    global manalhelp manalreg nmarkanal
    global AnalFormat
    global CurMAnalCmds

    set itemList ""
    if { ($markanallist != "NONE") && ($markanallist != "") } {
        lappend itemList {"Run Marker Analysis Task:" f.title}
        lappend itemList { f.dblline }
	set alist $markanallist
	# see how many different sources we have
	set lastfile ""
	set nfiles 0
        foreach entry $alist {
	    set file [lindex $entry 0]
	    if { $lastfile != $file } {
		incr nfiles
	    }
	    set lastfile $file
	}
	# for 1 source, just make a list ...
	if { ($nfiles == 1) || ($AnalFormat == "none") } {
	    set lastfile ""
	    set nfiles 0
	    set CurMAnalCmds 0
	    set n 0
	    foreach entry $alist {
		set file [lindex $entry 0]
		set anal [lindex $entry 1]
		if { $anal == "f.line" } {
		    lappend itemList "f.line"
		    continue
		} elseif { $anal == "f.dblline" } {
		    lappend itemList "f.dblline"
		    continue
		}		

		for {set i 0} {$i < $nmarkanal} {incr i} {
		    if { $anal == $manalhelp($i) } {
			set region [send $marker getRegion]
			set type [lindex $region 0]
			if { ([string first all $manalreg($i)] >= 0) || \
			     ([string first $type $manalreg($i)] >= 0) } {
				lappend itemList \
				"\{$anal\} f.exec \{ RunMarkerAnal $n \}"
			    incr CurMAnalCmds
			}
		    }
		}
		incr n
	    }
	} elseif { $AnalFormat == "line" } {
	    set lastfile ""
	    set nfiles 0
	    set CurMAnalCmds 0
	    set n 0
	    foreach entry $alist {
		set file [lindex $entry 0]
		set anal [lindex $entry 1]
		if { $lastfile != $file } {
		    if { $nfiles != 0 } {
			lappend itemList "f.line"
		    }
		    incr nfiles
		    set lastfile $file
		}
		if { $anal == "f.line" } {
		    lappend itemList "f.line"
		    continue
		} elseif { $anal == "f.dblline" } {
		    lappend itemList "f.dblline"
		    continue
		}		
		for {set i 0} {$i < $nmarkanal} {incr i} {
		    if { $anal == $manalhelp($i) } {
			set region [send $marker getRegion]
			set type [lindex $region 0]
			if { ([string first all $manalreg($i)] >= 0) || \
			     ([string first $type $manalreg($i)] >= 0) } {
				lappend itemList \
				  "\{$anal\} f.exec \{ RunMarkerAnal $n \}"
			    incr CurMAnalCmds
			}
		    }
		}
	        incr n
	    }
	    set nfiles 0
        } else {
	    set AnalFormat "submenu"
	    set lastfile ""
	    set nfiles 0
	    set CurMAnalCmds 0
	    set n 0
	    foreach entry $alist {
		set file [lindex $entry 0]
		set idx [string last "/" $file]
		if { $idx >= 0 } {
		    set name [string range $file [expr $idx + 1] end]
		} else {
		    set name $file
		}
		# look for duplicate of file name and make unique if so
		for {set i 1} {$i <= $nfiles} {incr i} {
		    if { $name == $AnalFile($i) } {
			if { $name != $file } {
			    set name $file
			} else {
			    set name [format "%s%s" $name [expr $nfiles + 1]]
			}
			break
		    }
		}
		set anal [lindex $entry 1]
		if { $lastfile != $file } {
		    incr nfiles
		    lappend itemList "\{$name ...\} f.menu ManalMenu$nfiles"
		    set AnalFile($nfiles) $name
		    set AnalList($nfiles) "" 
		    set lastfile $file
		}
		if { $anal == "f.line" } {
		    lappend AnalList($nfiles) "f.line"
		    continue
		} elseif { $anal == "f.dblline" } {
		    lappend AnalList($nfiles) "f.dblline"
		    continue
		}		
		for {set i 0} {$i < $nmarkanal} {incr i} {
		    if { $anal == $manalhelp($i) } {
			set region [send $marker getRegion]
			set type [lindex $region 0]
			if { ([string first all $manalreg($i)] >= 0) || \
			     ([string first $type $manalreg($i)] >= 0) } {
			        lappend AnalList($nfiles) \
				  "\{$anal\} f.exec \{ RunMarkerAnal $n \}"
			    incr CurMAnalCmds
			}
		    }
		}
		incr n
	    }
	}
    } else {
        lappend itemList \
		{"No Marker Analysis Tasks For Current Image!" f.title}
	set nfiles 0
	set CurMAnalCmds 0
    }
    editMenu markerAnalMenu toplevel $itemList
    ReBland  markerAnalMenu
    # add sub-menus if necessary 
    if { ($nfiles > 1) && ($AnalFormat == "submenu") } {
	# edit the menus
	for {set j 1} {$j <= $nfiles} {incr j} {
	    if { $AnalList($j) != "" } {
	        editMenu ManalMenu$j toplevel $AnalList($j)
	        ReBland  ManalMenu$j
	    }
	    if { [info procs ManalMenu$j] == "" } {
		eval "proc ManalMenu$j args {}"
	    }
	}		
    }
}

proc RunMarkerAnal { n } {
    global marker
    SendXPA "manalysis $n"
}

# #############################################################################
#
#  Routines to get a value from a dialog box
#
# #############################################################################

set dialogcmd ""		;# last command for this dialog
set dialogstore ""		;# where to store dialog value
set dialogtype "set"		;# "set" or "get"

#
# okDialog -- bring down a dialog box and send the string as an xpa command
#
proc okDialog args {
    global dialogtarget dialogcmd dialogstore dialogtype
    global debug

    send SAOtngDialog unmap
    xflush
    set value [send dialogValue get string]
    if { $dialogstore != ""} {
	# set value of passed variable name -- must be done 1 level up!
	set cmd [format "upvar 1 %s v; set v {%s}" $dialogstore $value]
	eval $cmd
    }
    if { $value != ""} {
	if { $dialogtype == "set" } {
	    SendXPA "$dialogcmd $value"
	} elseif { $dialogtype == "xeq" } {
	  if { $debug } {
	      print [format "Executing: '%s'" $dialogcmd]
	  }
	  uplevel #0 $dialogcmd
	} else {
	  Print "Warning: unknown dialog command type"
	}
    }
}
send dialogOk addCallback okDialog

#
# clearDialog -- clear the dialog string
#
proc clearDialog args {
    global dialogstore
    if { $dialogstore != ""} {
	# set value of passed variable name -- must be done 1 level up!
	set cmd [format "upvar 1 %s v; set v {%s}" $dialogstore ""]
	eval $cmd
    }
    send dialogValue set string ""
}
send dialogClear addCallback clearDialog

#
# cancelDialog -- cancel dialog
#
proc cancelDialog args {
    send SAOtngDialog unmap
    xflush
}
send dialogCancel addCallback cancelDialog

#
# startDialog -- bring up an XPA dialog box
#
proc startDialog {label cmd value store {type "set"}} {
    global dialogcmd dialogstore dialogtype

    send dialogLabel set label $label
    set dialogcmd $cmd
    send dialogValue set string $value
    set dialogstore $store
    set dialogtype $type
    send SAOtngDialog map
}


#
# LoadImage -- Load a new image
#
proc LoadImageHelper { file } {
    global markers_saved_frame frame
    DeleteMarker all
    SendXPA "file $file"
}

proc LoadImage { file } {
    global markers_saved_frame frame
    global MarkerWarning

    if { $MarkerWarning } {
        if { ([info exists markers_saved_frame($frame)] == 0) } {
	    LoadImageHelper $file
	} elseif {$markers_saved_frame($frame) == 0} {
	    Wexec "LoadImageHelper $file" "Loading an image deletes the markers. Continue?"
	} else {
	    LoadImageHelper $file
	}
    } else {
	LoadImageHelper $file
    }
}

#
# LoadNewImage -- pop up dialog to load new image
#
set filevalue ""		;# last value returned from this dialog
proc LoadNewImage args {
    global filevalue ImageDir

    if { $filevalue == "" } {   
	if { [info exists ImageDir] } {
	    set filevalue $ImageDir
	}
    }
    set cmd [format "LoadImage \$filevalue"]
    startDialog "Enter a new image name: " \
		"$cmd" "$filevalue" "filevalue" "xeq"
}

#
# Some misc but related tasks ...
# 

proc DisplayFitsHeader args {
	global xpa xpafd env

	OpenShell
	if { $xpafd == -1 } {
	    return
	}
	puts $xpafd "$env(XPAGET) $xpa file |& $env(XPASET) $xpa message"
    	flush $xpafd
	MessDisplay
}

proc ShowVersion args {
    global env
    if { [info exists env(SAORD_VERSION)] } {
	Print [format "SAOtng version: %s" $env(SAORD_VERSION)]
    } else {
	Print "Warning: no SAOtng version information available"
    }
    MessDisplay
}

set maxfitssize 0
proc MaxSize { param old new } {
    global maxfitssize
    set maxfitssize $new
}; send maxsize addCallback MaxSize

set maxfitsstr ""
proc SetMaxSize args {
    global maxfitssize maxfitsstr
    set maxfitsstr $maxfitssize
    startDialog "Enter a new max size for memory-based FITS: " \
		"file maxsize" "$maxfitsstr" "maxfitsstr" "set"
}

#
# mySaveFITS -- pop up dialog to save the current RAW FITS data to disk
#
set fitsvalue ""		;# last value returned from this dialog
proc mySaveFITS {filename} {
    global xpa xpafd env
    global SaveImageCmd

    set direct [file dirname $filename]
    set file   [file tail    $filename]

    set erra [file isdirectory $direct]
    if { $file == "" } { set errb 1 } else { set errb 0 }
    set errc [file isdirectory $filename]

    if { ($erra == 1) && ($errb == 0) && ($errc == 0) } {
	OpenShell
	if { $xpafd == -1 } {
	    return
	}
#	puts $xpafd "$env(XPAGET) $xpa fits raw_data > $filename"
	set cmd [format "puts $xpafd \"%s\"" $SaveImageCmd]
	eval $cmd
    	flush $xpafd
    } else {
	Wexec {SaveFITS} [format "Invalid filename: %s!" $filename]
    }
}

#
# SaveFITS -- pop up dialog to save the current fits to disk
#
set fitsvalue ""		;# last value returned from this dialog
proc SaveFITS args {
    global fitsvalue ImageDir

    if { $fitsvalue == "" } {   
	if { [info exists ImageDir] } {
	    set fitsvalue $ImageDir
	}
    }
    set cmd [format "mySaveFITS \$fitsvalue"]
    startDialog "Enter a filename for saving: " \
		"$cmd" "$fitsvalue" "fitsvalue" "xeq"
}

#
# SaveGIF -- pop up dialog to save the current RAW GIF data to disk
#
set gifvalue ""		;# last value returned from this dialog
proc SaveGIF args {
    global gifvalue ImageDir

    if { $gifvalue == "" } {   
	if { [info exists ImageDir] } {
	    set gifvalue $ImageDir
	}
    }
    startDialog "Enter a GIF filename for saving: " \
	"gif" "$gifvalue" "gifvalue"
}

proc mySaveRegions {filename} {
    global xpafd markers_saved_frame frame
    global SaveRegCmd xpa env

    set direct [file dirname $filename]
    set file   [file tail    $filename]

    set erra [file isdirectory $direct]
    if { $file == "" } { set errb 1 } else { set errb 0 }
    set errc [file isdirectory $filename]

    if { ($erra == 1) && ($errb == 0) && ($errc == 0) } {
	set markers_saved_frame($frame) 1
	OpenShell
	if { $xpafd == -1 } {
	    return
	}
	set cmd [format "puts $xpafd \"%s\"" $SaveRegCmd]
	eval $cmd
    	flush $xpafd
    } else {
	Wexec {SaveRegions} [format "Invalid filename: %s!" $filename]
    }
}

#
# SaveRegions -- pop up dialog to save the current regions to disk
#
set regvalue ""		;# last value returned from this dialog
proc SaveRegions args {
    global regvalue frame RegionDir

    if { $regvalue == "" } {   
	if { [info exists RegionDir] } {
	    set regvalue $RegionDir
	}
    }
    set cmd [format "mySaveRegions \$regvalue"]
    startDialog "Enter a marker filename for saving: " \
		"$cmd" "$regvalue" "regvalue" "xeq"
}

proc myLoadRegions {filename} {
    global xpafd
    global LoadRegCmd xpa env

    set proceed [file exists $filename]
    if {$proceed == 1} {
	OpenShell
	if { $xpafd == -1 } {
	    return
	}
	set cmd [format "puts $xpafd \"%s\"" $LoadRegCmd]
	eval $cmd
    	flush $xpafd
    } else {
       Wexec {SaveRegions} [format "Marker file does not exist: %s!" $filename]
    }
}

#
# LoadRegions -- pop up dialog to load regions from disk
#
proc LoadRegions args {
    global regvalue frame RegionDir

    if { $regvalue == "" } {   
	if { [info exists RegionDir] } {
	    set regvalue $RegionDir
	}
    }
    set cmd [format "myLoadRegions \$regvalue"]
    startDialog "Enter a marker filename for loading: " \
		"$cmd" "$regvalue" "regvalue" "xeq"
}

#
# RaiseXDirImages -- dialog routine to bring up XDir with image templates
#
proc RaiseXDirImages args {
    global xpa xpafd ImageDir
    global ImageFilter
    global guiFlavor env

    # make sure we have a shell to which we can send commands
    OpenShell
    if { $xpafd == -1 } {
        return
    }
    # check to see if XDir is running
    puts $xpafd	"if ( \"`$env(XPAACCESS) XDir`\" == \"no\" ) then"

    # if not, start if up
    puts $xpafd "setenv SAOTNG_XDIR True"
    if { [info exists ImageDir] } {
	set cmd [format "%s -dir '%s' -filter '%s' &" $env(XDIR) $ImageDir $ImageFilter]
    } else {
	set cmd [format "%s -filter '%s' &" $env(XDIR) $ImageFilter]
    }
    puts $xpafd $cmd
    # change the template and possible the directory
    puts $xpafd "else"
    puts $xpafd "echo 'raise' | $env(XPASET) -w XDir"
    if { [info exists ImageDir] } {
	set cmd [format "echo 'directory %s' | $env(XPASET) -w XDir" $ImageDir]
	puts $xpafd $cmd
    }
    set cmd [format "echo 'filter %s' | $env(XPASET) -w XDir" $ImageFilter]
    puts $xpafd $cmd
    puts $xpafd "endif"
    puts $xpafd "sleep 5"
    puts $xpafd "echo 'target $xpa' | $env(XPASET) -w XDir"
    flush $xpafd
}

#
# RaiseXDirMarkers -- dialog routine to bring up XDir with marker templates
#
proc RaiseXDirMarkers args {	
    global guiFlavor env
    global xpa xpafd RegionDir
    global RegionFilter

    # make sure we have a shell to which we can send commands
    OpenShell
    if { $xpafd == -1 } {
	return
    }

    # check to see if XDir is running
    puts $xpafd	"if ( \"`$env(XPAACCESS) XDir`\" == \"no\" ) then"

    # if not, start if up
    if { [info exists RegionDir] } {
      set cmd [format "%s -dir '%s' -filter '%s' &" $env(XDIR) $RegionDir $RegionFilter]
    } else {
      set cmd [format "%s -filter '%s' &" $env(XDIR) $RegionFilter]
    }
    puts $xpafd $cmd
    # change the template and possible the directory
    puts $xpafd "else"
    puts $xpafd "echo 'raise' | $env(XPASET) -w XDir"
    if { [info exists RegionDir] } {
	set cmd [format "echo 'directory %s' | $env(XPASET) -w XDir" $RegionDir]
	puts $xpafd $cmd
    }
    set cmd [format "echo 'filter %s' | $env(XPASET) -w XDir" $RegionFilter]
    puts $xpafd $cmd
    puts $xpafd "endif"
    puts $xpafd "sleep 5"
    puts $xpafd "echo 'target $xpa' | $env(XPASET) -w XDir"
    flush $xpafd
}

# #############################################################################
#
#  Routines that deal with printing
#
# #############################################################################

#
# PrintImage -- pop up dialog to print the current image
#
set printer "ghostview"		;# last value returned from this dialog
proc PrintImage args {
    global printer
    startDialog "Enter a print command: " \
	"print" "$printer" "printer" "set"
}

proc setPrinter { param old new } { 
    global printer
    set printer $new
}
send printer addCallback setPrinter

# #############################################################################
#
#  Routines that deal with selecting a given point on the image
#
# #############################################################################

set last_time 0
set repeat_mode 0

proc ImageSelectProc { x y time } \
{
    global last_time repeat_mode
    global block
    if { $last_time != 0 } {
        set diff [expr $time - $last_time]
    } else {
	set diff 1000
    }
    set last_time $time
    if { $diff < 500 } {
	incr repeat_mode
	if { $repeat_mode == 1 } {
	    SelectImage $x $y
	} elseif { $repeat_mode == 2 } {
	    # help user by resetting to block 1 from auto
	    if { $block == "auto" } {
		SetBlock 1
	    }
	    RedisplayImage
	}
    } else {
	UnselectImage
	set repeat_mode 0
    }
}


#
# SelectImage -- select the image displayed at the center of the given marker
#
proc SelectImage { x y } \
{
    set s [format "select frame %s %s" $x $y]
    SendXPA $s
}

#
# UnselectImage -- unselect the currently selected image
#
proc UnselectImage args {
    SendXPA "select none"
}

#
# RedisplayImage -- redisplay the currently selected image at the selected
# point, possibly getting new data from the file
#
proc RedisplayImageHelper args {
    global markers_saved_frame frame
#   DeleteMarker all
    SendXPA "redisplay"
}

proc RedisplayImage args {
    global markers_saved_frame frame
    global MarkerWarning

    if { $MarkerWarning } {
        if { ([info exists markers_saved_frame($frame)] == 0) } {
	    RedisplayImageHelper
	} elseif {$markers_saved_frame($frame) == 0} {
	    Wexec {RedisplayImageHelper} "Redisplay deletes the markers. Continue?"
	} else {
	    RedisplayImageHelper
	}
    } else {
	RedisplayImageHelper
    }
}

#
# DispFullImage -- redisplay the full current image
#
proc DispFullImageHelper args {
    global markers_saved_frame frame block
    DeleteMarker all
    UnselectImage
    # save the original block factor
    set myblock $block
    SetBlock "auto"
    # redisplay and restore original block factor
    SendXPA "redisplay; blocking $myblock"
}

proc DispFullImage args {
    global markers_saved_frame frame
    global MarkerWarning

    if { $MarkerWarning } {
        if { ([info exists markers_saved_frame($frame)] == 0) } {
	    DispFullImageHelper
	} elseif {$markers_saved_frame($frame) == 0} {
	    Wexec {DispFullImageHelper} "Full display deletes the markers. Continue?"
	} else {
	    DispFullImageHelper
	}
    } else {
	DispFullImageHelper
    }
}

# #############################################################################
#
#  
# setTitle -- Called when the frame title changes
# (e.g. frame change or new frame loaded).
#
# #############################################################################

# callback when the SAOtng part of the program gets a new image
proc setTitle { param old new } { 
    global titleFrame frame
    global tileframe blinkId autocf frameList

    if { $new == "NONE" } {
        set titleFrame($frame) " "
	UnsetScaleSamples
    } else {
        set titleFrame($frame) $new
    }
    send imageTitle set string $titleFrame($frame)
    redisplayMenus 1
    editMenu frameMenu toplevel [makeframeMenuDescription]
    ReBland  frameMenu
}
send imagetitle addCallback setTitle

# callback when the Imtool part of the program gets a new image
proc setImtoolTitle { param old new } { 
    global titleFrame frame
    global tileframe blinkId autocf frameList 

    if { $new != "" } {
        if { $new != "\[NO WCS\]\n" } {
	    if { ([info exists titleFrame($frame)] == 0) } {
		set titleFrame($frame) " "
	    } elseif { $titleFrame($frame) != $new } {
		DeleteMarker all
	    }
	    set titleFrame($frame) $new
            send imageTitle set string $titleFrame($frame)
	    UnsetScaleSamples
	    # we apparently have an IRAF-loaded image, so we need to
	    # destroy any externally loaded image that might be in
	    # the same frame.
	    SendXPA "destroy $frame noerase"
	    redisplayMenus 0
	} else {
	    redisplayMenus 1
	}
	editMenu frameMenu toplevel [makeframeMenuDescription]
        ReBland  frameMenu
    } else {
	redisplayMenus 1
    }
}
send frameTitle addCallback setImtoolTitle

proc redisplayMenus { { tstate -1 } } \
{
    global viewFrame frame

    if { ([info exists viewFrame($frame)] == 0) } {
	set viewFrame($frame) 1
    }
    if { $tstate >=0 } {
	set viewFrame($frame) $tstate
    }
    set state $viewFrame($frame)
    if { $state } {
	send scaleButton set sensitive True
	send scaleLabel set sensitive True
	send coordsButton set sensitive True
	send coordsLabel set sensitive True
# this is taken care of elsewhere
#	send analButton set sensitive True
#	send analLabel set sensitive True
	editMenu fileMenu toplevel [makefileMenuDescription True]
	ReBland  fileMenu
    } else {
	send scaleButton set sensitive False
	send scaleLabel set sensitive False
	send coordsButton set sensitive False
	send coordsLabel set sensitive False
	send analButton set sensitive False
	send analLabel set sensitive False
	editMenu fileMenu toplevel [makefileMenuDescription False]
	ReBland  fileMenu
    }	
# something has changed -- either the frame or the image,
# so we may as well update the WCS
    send imagewin getCursorPos x y
    wcsUpdate $x $y
}

# #############################################################################
#
# Command Button routines -- favorite commands are placed in buttons
#
# #############################################################################

# this must match the max number of accel buttons that were defined as widgets
# too bad we can't create widgets on the fly!
# this is the number of commands we can display for this screen size
set maxAccelCmds 25
set curAccelCmds 0

#
# process a list of accelerator commands
#
set defaccolor $BackgroundColor
set acctype "multi"

# allow a shell command to be executed from an accel button
proc shellcommand {action} {
    global xpafd
    OpenShell
    if { $xpafd == -1 } {
        return
    }
    puts $xpafd "$action"
    flush $xpafd
}

proc SetAccelColors args {
    global defaccolor  accelColors
    global curAccelCmds
    global acctype
    global CommandForeground

    for {set i 1} {$i <= $curAccelCmds} {incr i} {
	if { $acctype == "multi" } {
            send aB$i set background $accelColors($i)
            send aB$i set foreground $CommandForeground
        } elseif { $acctype == "bland" } {
	    send aB$i set background white
            send aB$i set foreground black
        } elseif { $acctype == "default" } {
	    send aB$i set background $defaccolor
            send aB$i set foreground $CommandForeground
        } else {
	    send aB$i set background $acctype
            send aB$i set foreground $CommandForeground
        }
    }
}

proc NewAccelColors { param old new } {
    global defaccolor  accelColors
    global maxAccelCmds curAccelCmds
    global acctype
    
    set acctype $new    
    SetAccelColors
}; send accolors addCallback NewAccelColors

proc NewAccelCmds { param old new } {
    global curAccelCmds maxAccelCmds  fitAccelCmds
    global defaccolor accelColors

    if {$old != $new} {
        set i [expr $curAccelCmds + 1]
        foreach cmd $new {
            set cc [string index cmd 0]
            if { $cc == "#" } {
                continue
            }
            set nelem [llength $cmd]
            if { $nelem < 3 } {
                Print "Warning: too few columns for accel button '%s'" $cmd]
                continue
            }
            set name [lindex $cmd 0]
            set type [lindex $cmd 1]
            set action [lindex $cmd 2]
	    if { $nelem == 4  } {
		set bcolor [lindex $cmd 3]
	    } else {
		set bcolor $defaccolor
	    }
            if { $i <= $maxAccelCmds } {
                send aB$i set label $name
                set accelColors($i) $bcolor
                if { $type == "xpa" } {
                    # make new callback on the fly containing the action string
                    # should be one callback with client_data but ...
                    set newproc [format "proc AccelXPA$i args {SendXPA \"%s\"}" $action]
                    eval $newproc
                    send aB$i addCallback AccelXPA$i
                } elseif { $type == "tcl" } {
                    set newproc [format "proc AccelXPA$i args {%s}" $action]
                    eval $newproc
                    send aB$i addCallback AccelXPA$i
                } elseif { $type == "menu" } {
                  set menuTranslation "Any<Btn1Down>: popup($action,\$x,\$y)\n\
				       Any<Btn1Up>: popdown($action,\$x,\$y)"
                   send aB$i set translations $menuTranslation
		} elseif { $type == "shell" } {
		    regsub -all {\$} $action {\\$} action
		    set newproc [format "proc AccelXPA$i args {shellcommand \"%s\"}" $action]
		    eval $newproc
		    send aB$i addCallback AccelXPA$i
                } else {
                    Print [format "Warning: unknown accel type '%s' for '%s'" \
                                  $type $action]
                }
		incr i
            } else {
                Print [format "Warning: too many accel buttons: %s" $name]
            }
        }
        set curAccelCmds [expr $i - 1]
	# readjust width of command buttons, if we don't need the scrollbar
	if { $curAccelCmds <= $fitAccelCmds } {
	    set nwidth [expr [send aF get width] + 10]
	    send aF set width $nwidth
	    for {set i 1} {$i <= [expr $curAccelCmds + 1]} {incr i} {
		set nwidth [expr [send aB$i get width] + 10]
    		send aB$i set width $nwidth
	    }
	# this does not work ... wonder why???
	} else {
	    send aF set borderWidth 1
	    send aV set borderWidth 1
	}
	# unmanage the unused widgets
	for {set i 1} {$i <= $curAccelCmds} {incr i} {
	    send aF manage aB$i
	}
	for {set i [expr $curAccelCmds + 1]} {$i <= $maxAccelCmds} {incr i} {
	    send aF unmanage aB$i
	}
	# set the colors of the accel buttons
	SetAccelColors
	send aV set mappedWhenManaged True
    }
}; send acclist addCallback NewAccelCmds

# #############################################################################
#
# Original XIMTOOL globals
# Global variables.
#
# #############################################################################

# Client state variables (UI parameter objects).  Certain of these parameters
# we mirror in Tcl variables here, updating the values with a callback when
# the parameter value changes.  Others require special callbacks.

set frameWidth 0		;# frame buffer width, pixels
set frameHeight 0		;# frame buffer height, pixels
set frameDepth 8		;# frame buffer pixel size, bits
set cursorMode 0		;# true when cursor read pending

set version			"saotng version 1.8"
# set winWidth 512		;# display window width
# set winHeight 512		;# display window height
set marker none			;# selected marker
set markno 0			;# used to name new markers

# #############################################################################
#
#  Original Ximtool GUI Parameter Callbacks
#
# #############################################################################

#
# Called when the frame being displayed changes.
#
proc frameChanged {param old new} {
    global frame
    set frame $new
}; send frame addCallback frameChanged

#
# Called when the frame was deleted.
#
proc frameDeleted {param old new} {
    global frame initialFrame

    if { [info exists initialFrame($new)] } {
	unset initialFrame($new)
    }
}; send deleteFrame addCallback frameDeleted

#
# Called when the number of frames changes.
#
proc setNFrames {param old new} {
    global nframes frames
    set nframes $new
    foreach i $frames {
	if {$i <= $nframes} {
	    send frameBox manage frame$i
	} else {
	    send frameBox unmanage frame$i 
	}
    }
}; send nframes addCallback setNFrames

#
# Called when the windowed region of the image raster changes.
#  (Not an original ximtool routine.)
#
proc setFrameRegion {param old new} {
    global frameSX frameSY frameSNX frameSNY
#    global dont_panzoomCursors

    set src_frame [lindex $new 0]

    if {$old == ""} {
#	set dont_panzoomCursors 0
    } else {
	set old_frame [lindex $old 0]
#	set dont_panzoomCursors [expr $src_frame != $old_frame]
    }

    set frameSX($src_frame) [lindex $new 1]
    set frameSY($src_frame) [lindex $new 2]
    set frameSNX($src_frame) [lindex $new 3]
    set frameSNY($src_frame) [lindex $new 4]
}; send frameRegion addCallback setFrameRegion

#
# Called whenever the current frame is zoomed or panned.
#
proc setFrameView {param old new} {
    global frameZoomX frameZoomY frameCenterX frameCenterY
    global frameScaleX frameScaleY 
    global frameViews
    global frame
    global initialFrame

    set frameViews($frame) $new
    set frameZoomX($frame) [lindex $new 0]
    set frameZoomY($frame) [lindex $new 1]
    set frameCenterX($frame) [lindex $new 2]
    set frameCenterY($frame) [lindex $new 3]
    set frameScaleX($frame) [lindex $new 4]
    set frameScaleY($frame) [lindex $new 5]

    # save the initial values for this frame -- we need them in case
    # we have to create external cursors when the frame is zoomed
    if { ([info exists initialFrame($frame)] == 0) } {
	set initialFrame($frame) $new
	# execute initial commands
	InitialCommands
    }
}; send frameView addCallback setFrameView

#
# pan/zoom cursors when window size changes
#
proc myPanzoomCursors	{markers \
			oldWinWidth oldWinHeight newWinWidth newWinHeight } {

    global frame
    global FixType FixPosition FixSize FixRotation FixPoints FixDelete 
    global FixZoom FixZoomSize

    set ilist $markers
    set n [llength $ilist]

    set h [expr ($newWinWidth - $oldWinWidth + 0.0) / 2.0 ]
    set v [expr ($newWinHeight - $oldWinHeight + 0.0) / 2.0 ]

    HideMlist
    # look though all cursors
    for {set i 1} {$i <= $n} {incr i} {
	set markerlist [lindex $ilist [expr $i-1]]

	set m [lindex $markerlist 0]
	set region "none"

	set err [catch { set region [send $m getPreciseRegion] }]
	if { $err == 0 } {

	    # get fix attributes
	    send $m getAttributes fix fix
	    # skip if we have fixed all zooming 
	    if { $fix & $FixZoom } {
	        continue
	    }
	    # temporarily free markers
	    send $m setAttributes fix 0

	    set name [lindex $region 0]

	    # move the cursor to its position in the new frameView

	    if { ($name == "polygon") || ($name == "line") } {
		    send $m getAttributes precisex bogus_x precisey bogus_y
		    set bogus_x [expr $bogus_x + 0.0]
		    set bogus_y [expr $bogus_y + 0.0]
	    } else {
		    set bogus_x [lindex $region 2]
		    set bogus_y [lindex $region 3]
	    }

	    set xnew [expr $bogus_x + $h]
	    set ynew [expr $bogus_y + $v]

	    send $m move $xnew $ynew

	    # reset the fixed state
	    send $m setAttributes fix $fix
	}
    }
    FrameMlist
}

#
# winResize -- called when the window is resized
#
proc winResize {w width height} { 
	global winWidth winHeight mlist
	global frame
	global panner_enable magnifier_enable
	global Restrict

	if { $Restrict } {
	  # we have to trap odd-sized widgets and adjust them
	  set retry 0
	  if { [expr $height % 2] == 1 } {
	    incr height -1
	    incr retry
	  }
	  if { [expr $width % 2] == 1 } {
	    incr width -1
	    incr retry
	  }
	  if { $retry } {
	    send imagewin resize $width $height
	  }	
	}

	myPanzoomCursors $mlist $winWidth $winHeight $width $height

	set winWidth $width
	set winHeight $height 

	Print [format "Setting new window width: %f" $width] 
	Print [format "Setting new window height: %f" $height]

}; send imagewin addCallback winResize resize

#
# SetFrameSize -- called when the frame size changes
#
proc SetFrameSize { param old new } {
    global frameWidth frameHeight frameDepth
    global panner_enable 
    global frame
    global initialFrame
    global panmag_mapping
    global pannerGeom

    set frameWidth [lindex $new 0]
    set frameHeight [lindex $new 1]
    set frameDepth [lindex $new 2]
    if { $panner_enable } {
# brute force ...
	send panmagWin getRect boundary \
		panmag_x panmag_y panmag_width panmag_height
	set pannerGeom [format "+%s+%s" $panmag_x $panmag_y]
	SetPanMag none
	SetPanMag panner
    }
#    # undo initialFrame so it gets re-inited by next frameView
#    if { [info exists initialFrame($frame)] } {
#	unset initialFrame($frame)
#    }
}; send frameSize addCallback SetFrameSize

# 
# setEnhancement -- Called when the color enhancement for a frame changes.
#
proc setEnhancement { param old new } {
    global frame enhancement
    set enhancement([lindex $new 0]) [lrange $new 1 end]
#    set oldcolor [lindex $old 1]
#    set newcolor [lindex $new 1]
#    if { $oldcolor != $newcolor } {
#        send colorLabel set label [format "%.6s" $newcolor]
#    }
}; send enhancement addCallback setEnhancement

# #############################################################################
#
#  Various original callbacks from ximtool
#
# #############################################################################

# use "full" for postive/negative values, "half" for positive values
set winrange "half"

proc cmapParams { param old new } {
    global winrange
    global maxContrast maxcontrast frame
    set what [lindex $new 0]
    if { $what == "half" } {
	set winrange "half"
    } elseif { $what == "full" } {
	set winrange "full"
    } elseif { $what == "maxcontrast" } {
        set val [lindex $new 1]
	if { ( $val == "" ) || ( $val <= 2 ) } {
	    set maxcontrast($frame) $maxContrast
	} else {
	    set maxcontrast($frame) $val
	}
    } else {
	Print [format "Warning: illegal colormap range '%s'" $new]
    }
    # redisplay with new values
    cpDisplayEnhancement {} {} {}
}; send cmapparams addCallback cmapParams

# WINDOW the current frame.
proc windowColormap {x y} \
{
    global winWidth winHeight maxcontrast frame
    global winrange contrastsign

  if { $winrange == "full" } {
      send client windowColormap \
	[expr "double($x) / $winWidth"] \
	[expr "(double($y) - $winHeight / 2.0) / $winHeight * \
	    ( $maxcontrast($frame) * 2.0 * $contrastsign($frame) )"]
  } else {
      send client windowColormap \
	[expr "double($x) / $winWidth"] \
	[expr "double($y) / $winHeight * \
	    ( $maxcontrast($frame) * 2.0 * $contrastsign($frame) )"]
  }
}

# ZOOM and PAN.
set xcen 0
set ycen 0
foreach i $frames {set zoomindex($i) 0}
set nzoomfactors 0
foreach i $zoomfactors {
	set zoomfactor($nzoomfactors) $i
	incr nzoomfactors
}

# Zoom or pan image at given center.
proc Zoom {x y} \
{
	global xcen ycen frame
	global zoomindex zoomfactor
	global nzoomfactors

	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 rx [expr "int ($rx) + 0.5"]
	set ry [expr "int ($ry) + 0.5"]

	# If the pointer did not move (much) zoom the image, otherwise
	# pan it.

	BusyCursor
	if {sqrt(pow($x-$xcen, 2) + pow($y-$ycen, 2)) < 4} {
	    set zoomindex($frame) [expr [incr zoomindex($frame)] % $nzoomfactors]
	    set mag $zoomfactor($zoomindex($frame))
#	    send client zoom $mag $mag $rx $ry
	    SetZoom "$mag $mag $rx $ry"
	} else {
#	    send client pan $rx $ry
	    SetPan "frame $rx $ry"
	    set xcen $x
	    set ycen $y
	}

	# Move the pointer so that it tracks the object feature the user
	# selected.

	send imagewin setCursorPos $rx $ry $raster
	send imagewin getCursorPos xcen ycen
	IdleCursor
}

# Zoom using a marker to indicate the region to be displayed.
proc zoomMarker { marker aspect } \
{
	global xcen ycen frame
	global winWidth winHeight
	global zoomindex nzoomfactors

	# getPreciseRegion returns: rectangle raster x y width height rotangle
	set region_mapped [send $marker getPreciseRegion]
	set region_unmap [unmapRegion $region_mapped]
	set type [lindex $region_unmap 0]
	set raster [lindex $region_unmap 1]
	set xcen [expr int([lindex $region_unmap 2]) + 0.5]
	set ycen [expr int([lindex $region_unmap 3]) + 0.5]
	set snx  [expr [lindex $region_unmap 4] * 2]
	if { $type == "circle" } {
	  set sny $snx
	} else {
	  set sny  [expr [lindex $region_unmap 5] * 2]
	}

	# Compute the magnification ratio.
	set xmag [expr "$winWidth / $snx"]
	set ymag [expr "$winHeight / $sny"]
	if {$aspect == "equal"} {
	    set mag [expr ($xmag < $ymag) ? $xmag : $ymag]
	    set xmag $mag;  set ymag $mag
	}

	# Zoom the image.
#	send client zoomAbs $xmag $ymag $xcen $ycen
	SetZoom "$xmag $ymag $xcen $ycen"

	# The following causes a button2 to redisplay the full image.
	send imagewin setCursorPos $xcen $ycen $raster
	send imagewin getCursorPos xcen ycen
	set zoomindex($frame) [expr $nzoomfactors - 1]
}

# CURSOR READ stuff.
proc setCursorMode {param old new} \
{
    global cursorMode

    if {$new == "on"} {
	send imagewin "activate; setCursorType ginMode"
	set cursorMode 1
    } elseif {$new == "off"} {
	send imagewin "setCursorType idle; deactivate"
	set cursorMode 0
    }
}


proc keyInput {widget event sx sy data} \
{
    global cursorMode frame

    if {!$cursorMode || $event != "keyPress"} \
	return
    if {[lindex $data 0] == "??"} \
	return

    # Convert raw screen coordinates to raster pixel coordinates.
    send imagewin unmapPixel $sx $sy raster rx ry

    # Return the cursor value and exit cursor mode.
    send client retCursorVal $rx $ry $frame 1 [lindex $data 0]
}

proc resetCursorMode args {
    global cursorMode frame
    if {$cursorMode} {
	send imagewin getCursorPos x y
	send client retCursorVal $x $y $frame 1 ^D
    }
}; send initialize addCallback resetCursorMode

send cursorMode addCallback setCursorMode
send imagewin addCallback keyInput input

# #############################################################################
#
# FRAME BLINK.  The current implementation is not very fancy, and just uses
# resources to set the blink rate and list of blink frames.
#
# #############################################################################

set blinkId 0
set blinkIndex 0
set blinkframe 0

set save_panner_enable 0
set save_magnifier_enable 0

proc toggleBlink args {
	global blinkId blinkRate blinkIndex
	global frame blinkframe
        global panner_enable magnifier_enable
        global save_panner_enable save_magnifier_enable
	global tileframe autocf

	if { $blinkId } {
	    deleteTimedCallback $blinkId
	    set blinkId 0
	    # reset all labels that we disabled during blinking
	    if { $blinkframe != 0 } {
		SetFrame $blinkframe
	    } else {
		SetFrame $frame
	    }	
	    # restore the panner
	    if { $save_panner_enable != 0 } {
		SetPanMag panner
	    } elseif { $save_magnifier_enable != 0 } {
		SetPanMag magnifier
	    }
	} else {
	    # disable labels during blinking
            send frameLabel set label "blink!"
	    # disable panner during blink
	    set save_panner_enable $panner_enable
	    set save_magnifier_enable $magnifier_enable
	    SetPanMag none
	    # start the blinking
	    set blinkId [postTimedCallback Blink [expr int($blinkRate * 1000)]]
	}
	set blinkIndex 0
	editMenu frameMenu toplevel [makeframeMenuDescription]
	ReBland  frameMenu
}

proc Blink args {
	global blinkId blinkRate blinkFrames blinkIndex blinkframe

# this is too slow for blinking ...
#	SetFrame [lindex $blinkFrames $blinkIndex]
	set blinkframe [lindex $blinkFrames $blinkIndex]
        send client setFrame $blinkframe
	incr blinkIndex
	if {$blinkIndex >= [llength $blinkFrames]} {
	    set blinkIndex 0
	}
	set blinkId [postTimedCallback Blink [expr int($blinkRate * 1000)]]
}

proc resetBlink args {
    global blinkId
    if {$blinkId} \
	toggleBlink
}; send initialize addCallback resetBlink


# #############################################################################
#
# COORDINATE readout (WCS box display).
#
# #############################################################################

proc dispCoords {x y} \
{
    send imagewin unmapPixel $x $y raster rx ry rz
    if {$raster} {
	Print [send client wcsinfo $x $y $rx $ry $rz]
    } else {
	Print [format " %7.2f %7.2f %7.1f " $rx $ry $rz]
    }
}

proc sendCoords {x y} \
{
    send imagewin unmapPixel $x $y raster rx ry rz
    # this must match the send for wcsinfo
    send client coords $x $y $rx $ry $rz
    IdleCursor
}

#
# CoordsCallback -- Called when the client is requesting the current coords
#
proc CoordsCallback { param old new } { 
	send imagewin setCursorType ginMode
}
send coords addCallback CoordsCallback

proc SetCoordTracking { param old new } {
    if { $new == "none" } {
	setTrack 0
	setTrack2 0
    } else {
	setTrack 1
	setTrack2 1
    }
    if { $new == "hms" } {
	send wcsbox set width 60ch
        send coordsLabel set label "hms/dms"
    } elseif { $new == "degrees" } {
	send wcsbox set width 60ch
        send coordsLabel set label "degrees"
    } elseif { $new == "pixels" } {
	send wcsbox set width 32ch
        send coordsLabel set label "pixels"
    } else {
        send coordsLabel set label " "
    }
    wcsboxWindowResize
}; send trackcoords addCallback SetCoordTracking

proc SetCoordFormat { coords } {
    SendXPA "coords $coords"
}

# WCSBOX -- Real time coordinate display.

set track_enable 0
set track_enable2 0
set box_width 60ch
set box_height 1ch
set wcs_update_init 0

proc wcsUpdate {x y} \
{
    global track_enable track_enable2 frame tileframe box_width
    global wcs_update_init
    global blinkId
    global autotile

    # hack -- wcsUpdate is being called by RedisplayMenus in SetCurrentFrame.
    # this can be called early enough so that the X server has not had a
    # chance to create the pixmap that unmapPixel accesses, causing an X
    # error.  To avoid this, we wait until the user puts the mouse into the
    # image window before updating the wcs (thereby ensuring that the window
    # is mapped and accessible). Uggh!
    if { $wcs_update_init == 0 } {
	if { ($x==0) && ($y==0) } {
	    return
	} else {
	    set wcs_update_init 1
	}
    }

    # Convert screen coords to raster pixel.
    send imagewin unmapPixel $x $y raster rx ry rz

    # When tiling frames set current frame to the frame the pointer is within.
    # but don't do this if we are blinking ...
    if {$tileframe && !$blinkId && $frame && $raster && $autotile} {
	set track_frame [send client getFrame $raster]
	if { $track_frame && ($frame != $track_frame) } {
	  SetFrame $track_frame
	}
    }

    # Update coords box.
    if { !$track_enable && !$track_enable2 } {
	return
    }

    if {$raster} {
	set text [send client wcsinfo $x $y $rx $ry $rz]
    } else {
	set text [format " %7.2f %7.2f %7.1f " $rx $ry $rz]
    }
    if { [llength $text] > $box_width } {
	SetCoordFormat hms
    }
    if {$track_enable2} {
        send wcstext "set string \{$text\}"
    }
    if {$track_enable} {
	send wcsbox "set text \{$text\}; redraw noerase"
    }
}

# Translations when pointer is inside wcs box.
set wcsTranslations { \
		   <Btn1Down>:  track-cursor() m_raise() m_markposAdd()
	 	     <Btn1Up>:  m_redraw() track-cursor()
	 	 <Btn1Motion>:  m_moveResize()
	        Any<Btn3Down>:	popup(wcsMenu,$x,$y)
	          Any<Btn3Up>:	popdown(wcsMenu)
	          <Key>Delete:	call(SetCoordFormat,none)
}

# this is the default text color for wcs display
set wcs_color "cyan"
proc w_setColor { marker color }  {
    global wcs_color
    send $marker "markpos; \
	set textColor $color;  set highlightColor $color; redraw"
    set wcscolor $color
}

createMenu wcsMenu toplevel {
    {	"Set WCS Display Preferences for All Images" f.title	}
    {				f.dblline			}
    {	"Display \"Natural\" Coords (e.g., hms for RA)"	f.exec {SetCoordFormat hms}     }
    {	"Display in Degrees"	f.exec {SetCoordFormat degrees} }
    {	"Display in Pixels"	f.exec {SetCoordFormat pixels}  }
    {	"No Display"		f.exec {SetCoordFormat none}    }
    {	f.line							}
    {	"Set WCS system for this image ..." f.menu "wcsSysMenu"	}
    {	"Set WCS Color ..."		f.menu "wcsColorMenu" 	}
}

createMenu wcsColorMenu toplevel {
    {	"WCS Text Color"	f.title				}
    {			f.dblline				}
    {	Black		f.exec "w_setColor wcsbox black"	}
    {	White		f.exec "w_setColor wcsbox white"	}
    {	Red		f.exec "w_setColor wcsbox red"		}
    {	Green		f.exec "w_setColor wcsbox green"	}
    {	Blue		f.exec "w_setColor wcsbox blue"		}
    {	Cyan		f.exec "w_setColor wcsbox cyan"		}
    {	Yellow		f.exec "w_setColor wcsbox yellow"	}
    {	Magenta		f.exec "w_setColor wcsbox magenta"	}
}

createMenu wcsSysMenu toplevel {
    {	"Set WCS Coordinate System for this image" f.title	}
    {				f.dblline			}
    {	"FK4/B1950"	f.exec {SetCoordFormat fk4}     	}
    {	"FK5/J2000"	f.exec {SetCoordFormat fk5} 		}
    {	"Galactic"	f.exec {SetCoordFormat galactic}  	}
    {	"Ecliptic"	f.exec {SetCoordFormat ecliptic}  	}
}

proc setTrack {state} \
{
    global track_enable wcsboxGeom
    global wcsTranslations wcs_color
    global box_width box_height
    global MarkerFont
	
    if {$state} {
	if {$track_enable} \
	    return

	send imagewin createMarker wcsbox \
	    type		text \
	    translations	$wcsTranslations \
	    createMode		noninteractive \
	    font		$MarkerFont \
	    textFont		$MarkerFont \
	    markerTextFont	$MarkerFont \
	    width		$box_width \
	    height		$box_height \
	    lineWidth		0 \
	    imageText		true \
	    textBgColor		black \
	    textColor		$wcs_color \
	    visible		false

	set box_width [send wcsbox get width]
	set box_height [send wcsbox get height]
	set defGeom [format "%sx%s-5-5" $box_width $box_height]
	send imagewin parseGeometry $wcsboxGeom $defGeom x y width height

	send wcsbox setAttributes \
	    x			$x \
	    y			$y \
	    activated		true \
	    visible		true \
	    sensitive		true

	send wcsbox {
	    addCallback wcsboxDestroyCallback destroy
	    addCallback wcsboxMoved moveResize
	}

	send imagewin addCallback wcsboxWindowResize resize
	set track_enable 1
	send imagewin getCursorPos x y
	wcsUpdate $x $y
    } elseif {$track_enable} {
	set track_enable 0
	send wcsbox destroy
    }
}

# toggleTrack -- toggle the track
proc toggleTrack args \
{
    global track_enable
    setTrack [expr !$track_enable]
}

proc setTrack2 {state} \
{
    global track_enable2
    set track_enable2 $state
    if { !$track_enable2 } {
#	send wcstext set label " "
	send wcstext set string " "
    }
}

proc wcsboxDestroyCallback args {
    global track_enable
    send imagewin deleteCallback wcsboxWindowResize
    set track_enable 0
}

# If the window is resized make the wcsbox track the corner.
proc wcsboxWindowResize args {
    global track_enable box_width box_height
    global wcsboxGeom

    if {$track_enable} {
	# Get new location.
	set box_width [send wcsbox get width]
	set box_height [send wcsbox get height]
	set defGeom [format "%sx%s-5-5" $box_width $box_height]
	send imagewin parseGeometry $wcsboxGeom $defGeom x y width height

	# Move the marker.
	send wcsbox "\
	    deleteCallback wcsboxMoved; \
	    markpos; setAttributes x $x y $y; redraw; \
	    addCallback wcsboxMoved moveResize"
    }
}

proc wcsboxMoved {marker event position} {
    global wcsboxGeom
    send wcsbox getRect boundary x y width height
    set wcsboxGeom [send imagewin getGeometry $x $y $width $height]
}

proc resetWcsbox {param old new} {
    global track_enable wcsboxGeom displayCoords
    if {$new == "done"} {
	setTrack [true $displayCoords]
	setTrack2 [true $displayCoords]
    } elseif {$track_enable} {
	setTrack 0
	setTrack2 0
	if {$new == "restart"} {
	    set wcsboxGeom -5-5
	}
    }
}; send initialize addCallback resetWcsbox

set patchwidth 4
proc dispPatch {x y} \
{
    global xflip yflip
    global patchwidth
    send client displayPatch $x $y $patchwidth $xflip $yflip
}

# #############################################################################
#
# PANNER / MAGNIFIER
#
# #############################################################################

# PANNER / MAGNIFIER.  A marker known as the panner/magnifier window may be 
# present within the main image window.
#
# When it is serving as the panner window, it displays, at a reduced 
# resolution, the full frame mapped into the main image window.  The currently 
# displayed region of the frame is indicated using a small marker within the 
# panner window.  This small marker may be moved or resized to pan or zoom 
# in the main display window.
#
# When the panner/magnifier window is serving as a magnifier, it displays a 
# 16x magnification of the area around the pointer in the main image window.

set panmag_x 0
set panmag_y 0
set panmag_width 0
set panmag_height 0
set prm_width 0
set prm_height 0

set panner_pan_enable 0
set panner_region_enable 0

set panmag_mapping 0

set panmag_color cyan
set last_panmag none

proc SetPanMagColor { color }  {
    global panner_enable magnifier_enable panmag_color

    set panmag_color $color
    if { $panner_enable } {
      send  pannerRegionMarker \
	"set lineColor $color;  set highlightColor $color; redraw"
    }
    if { $magnifier_enable } {
      send  magPointer \
	"set lineColor $color;  set highlightColor $color; redraw"
    }
}

# Panner window translations.
set panmagWinTranslations { \
  	  <Btn1Down>:  m_raise() m_markposAdd()
        <Btn1Motion>:  m_move()
    !Shift<Btn1Down>:  m_raise() m_markpos()
  !Shift<Btn1Motion>:  m_move()
	    <Btn1Up>:  m_redraw()
	    <Btn2Up>:  call(pannerPanXY,$x,$y)
       Any<Btn3Down>:  popup(panmagMenu,$x,$y)
         Any<Btn3Up>:  popdown(panmagMenu)
      <Key>BackSpace:  m_deleteDestroy()
         <Key>Delete:  m_deleteDestroy()
  ~Shift<Key>#KPLeft:  call(TranslatePanMarker,-1,0)
 ~Shift<Key>#KPRight:  call(TranslatePanMarker,1,0)
    ~Shift<Key>#KPUp:  call(TranslatePanMarker,0,-1)
  ~Shift<Key>#KPDown:  call(TranslatePanMarker,0,1)
  !Shift<Key>#KPLeft:  call(TranslatePanMarker,-5,0)
 !Shift<Key>#KPRight:  call(TranslatePanMarker,5,0)
    !Shift<Key>#KPUp:  call(TranslatePanMarker,0,-5)
  !Shift<Key>#KPDown:  call(TranslatePanMarker,0,5)
	   #KT<Key>l:  m_lower()
	   #KT<Key>r:  m_raise()
  	  <KeyPress>:  graphics-input()
       !Ctrl<Motion>:  
 	    <Motion>:  track-cursor() call(wcsUpdate,$x,$y)
}
regsub -all #KP $panmagWinTranslations  $KeyboardPrefix panmagWinTranslations
regsub -all #KT $panmagWinTranslations  $KeyTrans       panmagWinTranslations

# Panner window translations.
set panRegWinTranslations { \
	  <Btn1Down>:  m_raise() m_markposAdd()
	<Btn1Motion>:  m_moveResize()
    !Shift<Btn1Down>:  m_raise() m_markpos()
  !Shift<Btn1Motion>:  m_rotateResize()
	    <Btn1Up>:  m_redraw()
	  <Btn2Down>:  m_lower()
	    <Btn2Up>:  call(pannerPanXY,$x,$y)
       Any<Btn3Down>:  popup(panmagMenu,$x,$y)
         Any<Btn3Up>:  popdown(panmagMenu)
      <Key>BackSpace:  m_deleteDestroy()
         <Key>Delete:  m_deleteDestroy()
  ~Shift<Key>#KPLeft:  call(TranslatePanMarker,-1,0)
 ~Shift<Key>#KPRight:  call(TranslatePanMarker,1,0)
    ~Shift<Key>#KPUp:  call(TranslatePanMarker,0,-1)
  ~Shift<Key>#KPDown:  call(TranslatePanMarker,0,1)
  !Shift<Key>#KPLeft:  call(TranslatePanMarker,-5,0)
 !Shift<Key>#KPRight:  call(TranslatePanMarker,5,0)
    !Shift<Key>#KPUp:  call(TranslatePanMarker,0,-5)
  !Shift<Key>#KPDown:  call(TranslatePanMarker,0,5)
	   #KT<Key>l:  m_lower()
	   #KT<Key>r:  m_raise()
  	  <KeyPress>:  graphics-input()
       !Ctrl<Motion>:  
	    <Motion>:  track-cursor() call(wcsUpdate,$x,$y)
}
regsub -all #KP $panRegWinTranslations  $KeyboardPrefix panRegWinTranslations
regsub -all #KT $panRegWinTranslations  $KeyTrans       panRegWinTranslations

# setPanner -- Turn the panner on or off.
proc setPanner {state} \
{
    if {$state} {
	SetPanMag panner
    } else {
	SetPanMag none
    }
}

# togglePanner -- toggle the panner
proc togglePanner args \
{
    global panner_enable
    setPanner [expr !$panner_enable]
}

# raise the panner window
proc raisePanner { { flag "maybe" } } {
    global RaisePanMag

    if { $flag == "maybe" } {
	set flag [true $RaisePanMag]
    }
    if { $flag } {
        if [send server queryObject panmagWin] {
            send panmagWin raise
        }
        if [send server queryObject pannerRegionMarker] {
	    send pannerRegionMarker raise
        }
        if [send server queryObject wcsbox] {
            send wcsbox raise
        }
    }
}

# setMagnifier -- Turn the magnifier on or off.
proc setMagnifier {state} \
{
    if {$state} {
	SetPanMag magnifier
    } else {
	SetPanMag none
    }
}

# toggleMagnifier -- toggle the magnifier
proc toggleMagnifier args \
{
    global magnifier_enable
    setMagnifier [expr !$magnifier_enable]
}

# turn on/off the magnifier marker
set showMagPointer 1
proc toggleMagPointer args \
{
    global showMagPointer
    set showMagPointer [expr !$showMagPointer]	
    setMagPointerPosition
}

# set the position of the magnifier marker in the center of the mag window

proc setMagPointerPosition args \
{
    global showMagPointer
    global magnifier_enable

    if { !$magnifier_enable } {
	return
    }

    if { $showMagPointer } {
	    send panmagWin "getAttributes x x y y"
	    set xpos [expr $x + 1]
	    set ypos [expr $y + 1]

	    send magPointer \
		"setAttributes x $xpos y $ypos visible true; redraw"
    } else {
	    send magPointer \
		"setAttributes visible false; redraw"
    }	
}

# SetPanMag -- Turn the panner/magnifier on/off.

proc SetPanMag { panmag } \
{
    global winWidth winHeight frameWidth frameHeight
    global pannerArea pannerGeom
    global frame
    global panmag_mapping panmagWinTranslations panRegWinTranslations
    global magnifierWinTranslations
    global panner_enable panner_region_enable panner_pan_enable
    global magnifier_enable
    global panmag_x panmag_y panmag_width panmag_height
    global panmag_color
    global last_panmag

    set pan_req [expr {$panmag == "panner"}]
    set mag_req [expr {$panmag == "magnifier"}]

    # If what's requested is already there, just return

    if { ( $pan_req && $panner_enable    ) || 
         ( $mag_req && $magnifier_enable )    } \
	return

    if { $pan_req || $mag_req } {
	# this is required to ensure that the panmag window size
	# will be correctly changed
	if { ($last_panmag != $panmag) } {
	        set err [catch {send panmagWin getRect boundary \
		panmag_x panmag_y panmag_width panmag_height}]
		if { $err == 0 } {
		    set pannerGeom [format "+%s+%s" $panmag_x $panmag_y]
		} else {
		    set pannerGeom -5+5
		}

	    panmagDestroy
	}
	set last_panmag $panmag

	if { !$panner_enable && !$magnifier_enable } {

	    # Create the panner / magnifier window.

	    # Determine where to place the pan/mag window.
	    set scale \
		[expr sqrt(double($pannerArea) / ($frameWidth * $frameHeight))]
	    if { $pan_req } {
	        set scaled_width  [expr int($frameWidth * $scale) / 2 * 2 + 1]
	        set scaled_height [expr int($frameHeight * $scale) / 2 * 2 + 1]
	    } else {
	        set scaled_width  [expr int(sqrt(double($pannerArea)) + 1)]
	        set scaled_height [expr int(sqrt(double($pannerArea)) + 1)]
	    }
	    set defGeom [format "%sx%s-5+5" $scaled_width $scaled_height]
	    send imagewin parseGeometry $pannerGeom $defGeom x y width height

	    # Create the main pan/mag window (marker).
	    send imagewin createMarker panmagWin \
		type		box \
		createMode	noninteractive \
		width		[expr $width / 2] \
		height		[expr $height / 2] \
		x		[expr $x + $width / 2] \
		y		[expr $y + $height / 2] \
		lineWidth	3 \
		lineColor	4 \
		highlightColor	4 \
		translations	$panmagWinTranslations \
		visible		true \
		sensitive	true \
		activated	true

	    # Update the pan/mag window position variables so that it comes up
	    # in the same place the next time.
	    send panmagWin getRect boundary \
		panmag_x panmag_y panmag_width panmag_height
	    set pannerGeom [send imagewin getGeometry \
		$panmag_x $panmag_y $panmag_width $panmag_height]

	    # Register callbacks common to panner and magnifier.
	    send imagewin addCallback panmagImagewinResized resize
	    send resize addCallback panmagImagewinResized
	    send panmagWin {
		addCallback panmagMoved moveResize;
		addCallback panmagDestroy destroy;
		addCallback panmagWinConstraint constraint;
	    }

	    # Prepare for mapping into the pan/mag window.
	    set panmag_mapping [send imagewin nextMapping]

	} elseif { $panner_enable } {
	    pannerShutdown
	} else {
	    magnifierShutdown
	}

	# Now we have a pan/mag window ready to become panner or magnifier.

	if {$pan_req} {

	    # Register panner callbacks.
	    send frame addCallback pannerMapImage
	    send frameRegion addCallback pannerSetRegion
	    send panmagWin addCallback pannerMapImage moveResize

	    # Map display frame to panner window.
	    set panner_enable 1
	    set panner_region_enable 1
	    pannerMapImage
	    send imagewin refreshMapping $panmag_mapping

	    # Draw a marker in the panner window outlining displayed region.
	    send imagewin createMarker pannerRegionMarker \
		type		box \
		createMode	noninteractive \
		translations	$panRegWinTranslations \
		lineColor	$panmag_color \
		highlightColor	$panmag_color \
		sensitive	true

	    # Fire up the panner region marker.
	    send client getSource raster sx sy snx sny
	    pannerSetRegion "SetPanMag" "?" [concat $frame $sx $sy $snx $sny]
	    send pannerRegionMarker "\
		addCallback pannerPanImage moveResize; \
		addCallback panmagDestroy destroy; \
		addCallback pannerRegionConstraint constraint; \
		setAttributes visible true activated true; \
		redraw"
	    set panner_pan_enable 1

	} else {

	    # Register magnifier callbacks.
#	    send frame addCallback magnifierMapImage
	    send panmagWin addCallback magnifierMovedMapImage moveResize

	    # Map part of display frame to magnifier window.
	    set magnifier_enable 1
	    magnifierMapImage [expr $winWidth / 2] [expr $winHeight / 2]
	    send imagewin refreshMapping $panmag_mapping

	    # create cross-hair
	    send imagewin createMarker magPointer \
		    type		point \
		    createMode		noninteractive \
		    lineWidth		1 \
		    lineColor		$panmag_color \
		    activated		true \
		    visible		false

	    # set its position
	    setMagPointerPosition
	}

    } elseif { $panner_enable || $magnifier_enable } {
	panmagDestroy
    }
}


# pannerShutdown -- Shut down the panner, without deleting the pan/mag window.

proc pannerShutdown args {
    global panner_enable panner_region_enable panner_pan_enable

    # CAUTION --
    #  This procedure (pannerShutdown) sends "destroy" to pannerRegionMarker, 
    #  which triggers a call to panmagDestroy; if panner_enable is non-zero, 
    #  panmagDestroy will call this procedure (pannerShutdown); so, to avoid 
    #  unpleasant recursiveness, "set panner_enable 0" in this routine MUST 
    #  precede "send pannerRegionMarker destroy".

    set panner_pan_enable 0
    set panner_region_enable 0
    set panner_enable 0
    send frame deleteCallback pannerMapImage
    send frameRegion deleteCallback pannerSetRegion
    if [send server queryObject panmagWin] {
	send panmagWin deleteCallback pannerMapImage
    }
    if [send server queryObject pannerRegionMarker] {
	send pannerRegionMarker destroy
    }
}


# magnifierShutdown -- Shut down the magnifier, without deleting the 
# pan/mag window.

proc magnifierShutdown args {
    global magnifier_enable

    set magnifier_enable 0
    send frame deleteCallback magnifierMapImage
    if [send server queryObject panmagWin] {
	send panmagWin deleteCallback magnifierMovedMapImage
    }
    if [send server queryObject magPointer] {
        send magPointer destroy
    }
}


# panmagDestroy -- Delete the panner/magnifier window.

proc panmagDestroy args {
    global panner_enable magnifier_enable
    global panmag_mapping

    if { $panner_enable || $magnifier_enable } {
	if { $panner_enable } {
	    pannerShutdown
	} else {
	    magnifierShutdown
	}
	send imagewin freeMapping $panmag_mapping
	send imagewin deleteCallback panmagImagewinResized
	send resize deleteCallback panmagImagewinResized
	if [send server queryObject panmagWin] {
	    send panmagWin destroy
	}
	if [send server queryObject magPointer] {
	    send magPointer destroy
	}
    }
}


# pannerMapImage -- Map the current display frame into the panner window.
# Called when the frame changes or the panner window is moved or resized.
# The panner window displays a small dezoomed version of the full frame.

set pannerROP 0

proc pannerMapImage args {
    global panner_enable frame
    global panmag_mapping
    global xflip yflip
    global pannerROP

    if {!$panner_enable || $frame == 0} \
	return

    set raster [send client getRaster]
    send panmagWin getRect interior dx dy dnx dny
    send imagewin queryRaster $raster width height

    if [send imagewin activeMapping $panmag_mapping] {
	send imagewin raiseMapping $panmag_mapping
    }

    set dnx [expr abs($dnx)]
    set dny [expr abs($dny)]
#    if { [expr [string first x $flip] >= 0] }
    if {$xflip} {
	set dnx -$dnx
    }
#    if { [expr [string first y $flip] >= 0] }
    if {$yflip} {
	set dny -$dny
    }

    set err [catch {send imagewin setMapping $panmag_mapping $pannerROP \
	$raster pixel 0 0 $width $height \
	0 pixel $dx $dy $dnx $dny}]
    if { $err != 0 } {
	Print "There was a problem setting up the panner ... recovering"
    }

}


set last_mag_x [expr $winWidth / 2]
set last_mag_y [expr $winHeight / 2]

# magnifierMovedMapImage -- Front end to magnifierMapImage, called when 
# magnifier window is moved or resized.

proc magnifierMovedMapImage args {
    global last_mag_x last_mag_y

    magnifierMapImage $last_mag_x $last_mag_y
    setMagPointerPosition
}

# globals for magnifier
set mag_w 0
set mag_h 0

#
# setMagnifierZoom -- set the zoom factor for the magnifier
#
proc setMagnifierZoom { zoom } \
{
    global mag_w mag_h
    send panmagWin getRect boundary \
		panmag_x panmag_y panmag_width panmag_height
    set mag_w [expr int( ( $panmag_width  + $zoom - 1 ) / $zoom) ]
    set mag_h [expr int( ( $panmag_height + $zoom - 1 ) / $zoom) ]
}

# magnifierMapImage -- Map the 32 x 32 box of the current display frame 
# centered on the pointer into the magnifier window.
# Called when the frame changes, the pointer moves in the main image window, 
# or (via magnifierMovedMapImage) the magnifier window is moved or resized.

set magnifierROP 0

proc magnifierMapImage {x y} \
{
    global magnifier_enable frame
    global last_mag_x last_mag_y
    global panmag_mapping
    global winWidth winHeight
    global mag_w mag_h
    global magnifierROP

    if {!$magnifier_enable || $frame == 0} \
	return

    set last_mag_x $x
    set last_mag_y $y

    send panmagWin getRect interior dx dy dnx dny
    if [send imagewin activeMapping $panmag_mapping] {
	send imagewin raiseMapping $panmag_mapping
    }
    # initialize the magnifier zoom factor, if necessary
    if { !$mag_w || !$mag_h } {
	setMagnifierZoom 4
    }

    set sx [expr $x - $mag_w / 2 ]
    set sy [expr $y - $mag_h / 2 ]

    # Constrain the source rectangle within the main image window 
    # (not overlapping an edge or the magnifier window).

    if {$sx > [expr $dx - $mag_w] && $sx < [expr $dx + $dnx] && 
        $sy > [expr $dy - $mag_h] && $sy < [expr $dy + $dny]    } {

	# The source rectangle would overlap the magnifier window; fix that.

	set dist(l) [expr $sx - ($dx - $mag_w)]
	set dist(b) [expr $dy + $dny - $sy]
	set dist(r) [expr $dx + $dnx - $sx]
	set dist(t) [expr $sy - ($dy - $mag_h)]

	#  Put the distances in order.

	foreach j [array names dist] {
	    set alreadyset($j) 0
	}

	for {set i 0} {$i < 4} {incr i} {
	    set candidate ""
	    foreach j [array names dist] {
		if {!$alreadyset($j)} {
		    if {$candidate == ""} {
			set candidate $j
			set minsofar $dist($j)
		    } elseif {$dist($j) < $minsofar} {
			set candidate $j
			set minsofar $dist($j)
		    }
		}
	    }
	    set order($i) $candidate
	    set alreadyset($candidate) 1
	}

	# Try the sides in order, using the first one where there's room.

	for {set i 0} {$i < 4} {incr i} {
	    if {$order($i) == "l"} {
		if {$dx >= $mag_w} {
		    set sx [expr $dx - $mag_w]
		    break
		}
	    } elseif {$order($i) == "b"} {
		if {$winHeight >= $dy + $dny + $mag_h} {
		    set sy [expr $dy + $dny]
		    break
		}
	    } elseif {$order($i) == "r"} {
		if {$winWidth >= $dx + $dnx + $mag_w} {
		    set sx [expr $dx + $dnx]
		    break
		}
	    } elseif {$order($i) == "t"} {
		if {$dy >= $mag_h} {
		    set sy [expr $dy - $mag_h]
		    break
		}
	    }
	}
    }

    # Make sure we don't go beyond an edge of the main window.

    if {$sx < 0} {
	set sx 0
    } else {
	set sxmax [expr $winWidth - $mag_w]
	if {$sx > $sxmax} {
	    set sx $sxmax
	}
    }

    if {$sy < 0} {
	set sy 0
    } else {
	set symax [expr $winHeight - $mag_h]
	if {$sy > $symax} {
	    set sy $symax
	}
    }

    # Map 32 x 32 centered on pointer in main window.
    set err [catch {send imagewin setMapping $panmag_mapping $magnifierROP \
	0 pixel $sx $sy $mag_w $mag_h \
	0 pixel $dx $dy $dnx   $dny}]
    if { $err != 0 } {
	Print "There was a problem setting up the magnifier ... recovering"
    }
}


# pannerSetRegion -- Adjust the pannerWin region marker to outline the
# region displayed in the main display window.  This is called in response
# to a frameRegion event when the main display mapping changes, e.g. when
# the frame changes or the user zooms or pans the main window.  The region
# marker is moved and resized to reflect the new view.

proc pannerSetRegion {param old new} {
    global panner_enable panner_region_marker
    global panner_region_enable panner_pan_enable
    global frame frameWidth frameHeight prm_width prm_height
    global xflip yflip

    if {!$panner_enable || !$panner_region_enable || $frame == 0} \
	return

    # new: frame sx sy snx sny
    set src_frame [lindex $new 0]

    if {$src_frame != $frame} \
	return

    set sx [lindex $new 1];  set snx [lindex $new 3]
    set sy [lindex $new 2];  set sny [lindex $new 4]

    send panmagWin getRect interior px py pnx pny

    set x [expr ($sx + $snx/2.0) / $frameWidth * $pnx]
    if {$xflip} {
	set x [expr $px + $pnx - $x]
    } else {
	set x [expr $px + $x]
    }
    set y [expr ($sy + $sny/2.0) / $frameHeight * $pny]
    if {$yflip} {
	set y [expr $py + $pny - $y]
    } else {
	set y [expr $py + $y]
    }
    set width [expr ($snx/2.0) / $frameWidth * $pnx]
    set height [expr ($sny/2.0) / $frameHeight * $pny]

    set pan_save $panner_pan_enable;  set panner_pan_enable 0
    set panner_region_enable 0

    send pannerRegionMarker "\
	markpos; \
	setAttributes x $x y $y width $width height $height; \
	redraw; raise"
    send pannerRegionMarker getAttributes width prm_width height prm_height

    set panner_region_enable 1
    set panner_pan_enable $pan_save
}

# translate a marker
proc TranslatePanMarker { xoff yoff } \
{
    # get current size and position
    # getRegion returns: "box raster x y width height rotangle".
    set region_mapped [send pannerRegionMarker getRegion]
    set x [lindex $region_mapped 2]
    set y [lindex $region_mapped 3]
    # calculate new position
    set x [expr $x + $xoff]
    set y [expr $y + $yoff]
    # set new position
    send pannerRegionMarker "markpos; move $x $y; redraw"
}

proc pannerPanImage {marker event position} {
    global panner_pan_enable
    global winWidth winHeight
    global prm_width prm_height
 
    if {!$panner_pan_enable} \
        return
 
    # position: x y width height.
    set new_width [lindex $position 2]
    set new_height [lindex $position 3]
 
    # region: type raster x y width height.
    set region [send pannerRegionMarker getRegion unmap]
    set x [expr [lindex $region 2] + 1];  set width [lindex $region 4]
    set y [expr [lindex $region 3] + 1];  set height [lindex $region 5]
    set x [expr [expr "int ($x)"] + 0.5]
    set y [expr [expr "int ($y)"] + 0.5]
 
    set panner_pan_enable 0
    if {$new_width == $prm_width && $new_height == $prm_height} {
        SetPan "frame $x $y"
    } else {
        set xscale [expr ($winWidth / 2.0) / $width]
        set yscale [expr ($winHeight / 2.0) / $height]
        SetZoom "$xscale $yscale $x $y"
    }
    set panner_pan_enable 1
}

# pannerPanXY -- Pan to the point X,Y in the panner window coordinate
# system.  Called when the user clicks MB2 in the panner window.

proc pannerPanXY {x y} {
    send imagewin unmapPixel $x $y raster rx ry
#   send client pan $rx $ry
    SetPan "frame $rx $ry"
}

proc panmagRedraw args {
    global panner_enable magnifier_enable

    if { $panner_enable || $magnifier_enable } {
	 send panmagWin redraw
    }
    if { $panner_enable } {
 	 send pannerRegionMarker redraw
    }
}

# panmagMoved -- Called when the user moves the pan/mag window.  We need to
# record the new location so that the window will come up in the same place 
# if closed and reopened.  If it's the panner window, we also need to move 
# the region marker to the new window location.

proc panmagMoved {marker event position} {
    global panmag_x panmag_y panmag_width panmag_height
    global pannerGeom
    global panner_enable frame panner_pan_enable

    # Update the pan/mag window position variables so that it comes up
    # in the same place the next time.

    send panmagWin getRect boundary \
	panmag_x panmag_y panmag_width panmag_height
    set pannerGeom [send imagewin getGeometry \
	$panmag_x $panmag_y $panmag_width $panmag_height]

    if { $panner_enable } {
	# Move the region marker to the new location.
	set pan_save $panner_pan_enable;  set panner_pan_enable 0
	send client getSource raster sx sy snx sny
	pannerSetRegion "panmagMoved" "?" [concat $frame $sx $sy $snx $sny]
	set panner_pan_enable $pan_save
	send pannerRegionMarker raise
    }
}


# panmagWinConstraint -- Called when the pan/mag window is moved, resized, or
# rotated.  Constrain the pan/mag window to remain within the image window;
# rotation is not permitted.

proc panmagWinConstraint {marker event attributes} {
    global winWidth winHeight
    global panmag_width panmag_height

    set width $panmag_width
    set height $panmag_height
    set constraints [list {}]

    # Check the width and height first as we need these below.
    foreach i $attributes {
	set new [lindex $i 2]
	switch [lindex $i 0] {
	    width	{   set ww [expr $winWidth / 2]
			    if {$new > $ww} {
				lappend constraints "width $ww"
				set width $ww
			    } else {
				set width $new
			    }
			}
	    height	{   set wh [expr $winHeight / 2]
			    if {$new > $wh} {
				lappend constraints "height $wh"
				set height $wh
			    } else {
				set height $new
			    }
			}
	    rotangle	{    lappend constraints "rotangle 0"
			}
	}
    }

    # Constrain X and Y.
    foreach i $attributes {
	set new [lindex $i 2]
	switch [lindex $i 0] {
	    x		{   set pw [expr $width / 2]
			    if {$new < $pw} {
				lappend constraints "x $pw"
			    } elseif {$new > [expr $winWidth - $pw] } {
				lappend constraints "x [expr $winWidth - $pw]"
			    }
			}
	    y		{   set ph [expr $height / 2]
			    if {$new < $ph} {
				lappend constraints "y $ph"
			    } elseif {$new > [expr $winHeight - $ph] } {
				lappend constraints "y [expr $winHeight - $ph]"
			    }
			}
	}
    }

    return $constraints
}


# pannerRegionConstraint -- Called when the region marker in the panner
# window is moved, resized, or rotated.

proc pannerRegionConstraint {marker event attributes} {
    global winWidth winHeight

    set constraints [list {}]
    send panmagWin getRect interior p_x p_y p_width p_height
    send pannerRegionMarker getAttributes width rwidth height rheight

    # Since the panner region marker is a box marker x,y and width,height
    # will not both change in the same call, so we can process them all
    # independently.

    foreach i $attributes {
	set new [lindex $i 2]

	switch [lindex $i 0] {
	    x		{   set left [expr $p_x + $rwidth + 1]
			    set right [expr $p_x + $p_width - $rwidth - 1]
			    if {$new < $left} {
				lappend constraints "x $left"
			    } elseif {$new > $right} {
				lappend constraints "x $right"
			    }
			}
	    y		{   set top [expr $p_y + $rheight + 1]
			    set bottom [expr $p_y + $p_height - $rheight - 1]
			    if {$new < $top} {
				lappend constraints "y $top"
			    } elseif {$new > $bottom} {
				lappend constraints "y $bottom"
			    }
			}
	    width	{   set ww [expr $winWidth / 2]
			    if {$new > $ww / 2} {
				lappend constraints "width $ww"
			    }
			}
	    height	{   set wh [expr $winHeight / 2]
			    if {$new > $wh / 2} {
				lappend constraints "height $wh"
			    }
			}
	    rotangle	{    lappend constraints "rotangle 0"
			}
	}
    }

    return $constraints
}


# panmagImagewinResized -- If the display window is resized make the pan/mag 
# window track the corner.

proc panmagImagewinResized args {
    global panner_enable panmag_mapping
    global pannerGeom panmag_x panmag_y panmag_width panmag_height
    global magnifier_enable

    if { $panner_enable || $magnifier_enable } {
	set old_x $panmag_x;  set old_width $panmag_width
	set old_y $panmag_y;  set old_height $panmag_height

	# Get new location of panner window.
	set defGeom [format "%sx%s-5+5" $panmag_width $panmag_height]
	send imagewin parseGeometry $pannerGeom $defGeom x y width height

	# Reposition the marker.
	send panmagWin "\
	    markpos; \
	    setAttributes \
		x		[expr $x + $width / 2] \
		y		[expr $y + $height / 2] \
		width		[expr $width / 2] \
		height		[expr $height / 2]; \
	    redraw"

	if { !$panner_enable && !$magnifier_enable } {
	    return
	}

	# Update the pan/mag window position variables so that it comes up
	# in the same place the next time.
	send panmagWin getRect boundary \
	    panmag_x panmag_y panmag_width panmag_height
	set pannerGeom [send imagewin getGeometry \
	    $panmag_x $panmag_y $panmag_width $panmag_height]

	# Make sure the pan/mag window is on top.
	send imagewin raiseMapping $panmag_mapping

	# Refresh the pan/mag window if it did not move.
	if {$panmag_x == $old_x && $panmag_y == $old_y &&
	    $panmag_width == $old_width && $panmag_height == $old_height} {
	    send imagewin refreshMapping $panmag_mapping
	}

	if { $magnifier_enable } {
	    magnifierMovedMapImage
	}
    }
}


# resetPanner -- Reinitialize the panner.
proc resetPanner {param old new} {
    global pannerGeom displayPanner

    if {$new == "done"} {
	if { $displayPanner == "panner" } {
	   setPanner 1
	} 

	if { $displayPanner == "magnifier" } {
	   setMagnifier 1
	}
    } else {
	setPanner 0
	if {$new != "startup"} {
	    set pannerGeom -5+5
	}
    }
}; send initialize addCallback resetPanner

#
# Normalize -- Reset the view parameters for the current frame.
#
proc normalize args {
    global zoomindex zoomfactor
    global frameWidth frameHeight
    global xcen ycen frame
    global maxcontrast maxContrast contrastsign

    #set zoomindex($frame) 0
    #set xcen [expr $frameWidth / 2]
    #set ycen [expr $frameHeight / 2]
    #send client zoom 1 1 $xcen $ycen
    set maxcontrast($frame) $maxContrast
    set contrastsign($frame) 1
    send client windowColormap 0.5 1.0
    send invertButton set on [expr $contrastsign($frame) < 0]
}

#
# Track -- generic tracking updates based on mouse movements
#
proc Track { x y } {
    wcsUpdate $x $y
    magnifierMapImage $x $y
}

# #############################################################################
#
# MAIN CONTROL PANEL
#
# #############################################################################

set panel_up 0

send prevFrame set bitmap larrow
send nextFrame set bitmap rarrow
send contrastLabel set bitmap contrast
send maxcontrastLabel set bitmap maxcontrast
send brightnessLabel set bitmap brightness
send contrastSlider resizeThumb 0.1 1.0
send maxcontrastSlider resizeThumb 0.1 1.0
send brightnessSlider resizeThumb 0.1 1.0

proc controlPanelDone args {
    global panel_up
    send controlShell unmap
    set panel_up 0
}; send doneButton addCallback controlPanelDone

# panel -- Toggle control panel display.
proc panel args {
    global panel_up
    if {$panel_up} {
	send controlShell unmap
	set panel_up 0
    } else {
	send controlShell map
	set panel_up 1
    }
}

# resetPanel -- Calling during startup or in an initialize, to reset things.
proc resetPanel {param old new} {
    global frame nframes frames
    global displayPanner displayCoords
    global blinkFrames warnings

    switch $new {
    startup	{
		}
    restart	{   foreach i $frames {
			send frame$frame set on 0
		    }
		}
    done	{   if {$frame} {
			send frame$frame set on 1
		    }

		    cpResetBlink
		    set button 1
		    foreach i $blinkFrames {
			send blinkFrame$button set label $i
			incr button
		    }

		    cpResetEnhance
		    if { $displayPanner == "panner" } {
			 send pannerButton set on [true true]
		    } 

		    if { $displayPanner == "magnifier" } {
			 send magnifierButton set on [true true]
		    } 		

		    send coordsBoxButton set on [true $displayCoords]
		    send warningsButton set on $warnings
		}
    }
}; send initialize addCallback resetPanel

if { [true $DisplayControlPanel] } {
  panel
}


# Frame selection.
# -------------------------------
proc cpSetFrame {widget args} {
    send $widget set on 0
#   send client setFrame [send $widget get label]
    SetFrame [send $widget get label]
}

# this must match the number of frames defined for the control panel
# display -- we can't handle an unlimited number of frames in that panel
set maxframes 4
proc cpFrameChanged {param old new} {
    global maxframes
    if { ( $old > 0 ) && ( $old <= $maxframes ) } {
	send frame$old set on 0
    }
    if { ( $new > 0 ) && ( $new <= $maxframes ) } {
	send frame$new set on 1
    }
}

send prevFrame addCallback PrevFrame
send nextFrame addCallback NextFrame
send frame addCallback cpFrameChanged
foreach i $frames {send frame$i addCallback cpSetFrame}

# Frame buttons.
proc cpFrameAction {widget args} {
    global frameZoomX frameZoomY frame
    switch $widget {
    aspect	{   set xmag $frameZoomX($frame)
		    set ymag $frameZoomY($frame)
		    set zoom [expr round (($xmag + $ymag) / 2.0)]
		    cpZoom $zoom $zoom fixed
		}
    flipX	{   SetFlip "x" }
    flipY	{   SetFlip "y" }
    flipXY	{   SetFlip "xy" }
    clearframe	{   clearFrame }
    fitframe	{   fitFrame }
    }
}
foreach widget { aspect flipX flipY flipXY clearframe fitframe } {
    send $widget addCallback cpFrameAction
}

# clearFrame -- Clear the current display frame.
proc clearFrame	args {
    global warnings
    DestroyImage
}

# fitFrame -- Resize the display window to fit the frame buffer.
proc fitFrame args {
    global frameWidth frameHeight winWidth winHeight
    set dw [expr [send imagewin get width] - $winWidth]
    set dh [expr [send imagewin get height] - $winHeight]
    send imagewin "resize [expr $frameWidth + $dw] [expr $frameHeight + $dh]"
}


# Zoom and pan buttons.
# -------------------------------
proc cpZoomAction {widget args} {
    global frameWidth frameHeight

    switch $widget {
    x1		{   cpZoom 1 1 fixed }

    z2		{   cpZoom 2 2 fixed }
    z3		{   cpZoom 3 3 fixed }
    z4		{   cpZoom 4 4 fixed }
    z5		{   cpZoom 5 5 fixed }
    z8		{   cpZoom 8 8 fixed }

    d2		{   cpZoom [expr 1.0/2] [expr 1.0/2] fixed }
    d3		{   cpZoom [expr 1.0/3] [expr 1.0/3] fixed }
    d4		{   cpZoom [expr 1.0/4] [expr 1.0/4] fixed }
    d5		{   cpZoom [expr 1.0/5] [expr 1.0/5] fixed }
    d8		{   cpZoom [expr 1.0/8] [expr 1.0/8] fixed }

    zoomIn	{   cpZoom 2.0 2.0 relative }
    zoomOut	{   cpZoom 0.5 0.5 relative }

    centerFrame	{   SetZoom "center"
		}

    toggleZoom	{   ToggleZoom }
    }
}

proc cpZoom {zoom_x zoom_y mode} {
    global frameZoomX frameZoomY zoomindex frame

    if {$mode == "fixed"} {
#	send client zoom $zoom_x $zoom_y
	SetZoom "$zoom_x $zoom_y"
    } else {
#	send client zoom \
#	    [expr $frameZoomX($frame) * $zoom_x] \
#	    [expr $frameZoomY($frame) * $zoom_y]
	SetZoom "[expr $frameZoomX($frame) * $zoom_x] [expr $frameZoomY($frame) * $zoom_y]"
    }

    set zoomindex($frame) 0
}

proc ToggleZoom	args {
    global frameZoomX frameZoomY frameCenterX frameCenterY
    global frameWidth frameHeight saveView frame

    if { [info exists saveView($frame)] } {
	SetZoom "$saveView($frame)"
	unset saveView($frame)
    } else {
	set saveView($frame) \
	    "$frameZoomX($frame) $frameZoomY($frame) \
	     $frameCenterX($frame) $frameCenterY($frame)"
	SetZoom "1 1 [expr $frameWidth/2.0] [expr $frameHeight/2.0]"
    }
}

foreach widget { toggleZoom centerFrame zoomIn zoomOut\
	x1  z2 z3 z4 z5 z8  d2 d3 d4 d5 d8 } {
    send $widget addCallback cpZoomAction
}

# Frame data display.
# -------------------------------
set cpFrame 0
set cpXcen 0
set cpYcen 0
set cpXmag 0
set cpYmag 0
set cpXscale 0
set cpYscale 0

proc cpDisplayFrameData {name old new} {
    global cpFrame cpXcen cpYcen
    global cpXmag cpYmag cpXscale cpYscale

    if { $new == "" } {
	return
    }
    set update 0
    switch $name {
    frame	{   if {$new != $cpFrame} {
			set cpFrame $new
			set update 1
		    }
		}
    frameView	{   # Parse the frameView input.
		    set xmag  [lindex $new 0]; set ymag  [lindex $new 1]
		    set xcen  [lindex $new 2]; set ycen  [lindex $new 3]
		    set xnorm [lindex $new 4]; set ynorm [lindex $new 5]

		    # We need client coords and the overall scale factors.
		    set text [send client encodewcs $xcen $ycen]
		    set xcen [lindex $text 0]
		    set ycen [lindex $text 1]
		    set xscale [expr $xmag * $xnorm]
		    set yscale [expr $ymag * $ynorm]

		    if {$xcen != $cpXcen || $ycen != $cpYcen ||
			$xmag != $cpXmag || $ymag != $cpYmag ||
			$xscale != $cpXscale || $yscale != $cpYscale} {
			set cpXcen $xcen;  set cpXscale $xscale
			set cpYcen $ycen;  set cpYscale $yscale
			set cpXmag $xmag;  set cpYmag $ymag
			set update 1
		    }
		}
    }

    if {$update} {
	set header [format "-- Frame %d --" $cpFrame]
	set center [format "X center: %0.1f\nY center: %0.1f" $cpXcen $cpYcen]
	if {int($cpXmag) >= 10} {
	    set zoom1 [format " X zoom: %0.1f" $cpXmag]
	    set zoom2 [format " Y zoom: %0.1f" $cpYmag]
	} else {
	    set zoom1 [format "X zoom: %0.1f" $cpXmag]
	    set zoom2 [format "Y zoom: %0.1f" $cpYmag]
	}
	if {int($cpXscale) >= 10} {
	    set scale1 [format "X scale: %0.1f" $cpXscale]
	    set scale2 [format "Y scale: %0.1f" $cpYscale]
	} else {
	    set scale1 [format "X scale: %0.2f" $cpXscale]
	    set scale2 [format "Y scale: %0.2f" $cpYscale]
	}
	send frameData set label [format "%s\n%s\n%s\n%s\n%s\n%s" \
	    $header $center $scale1 $scale2 $zoom1 $zoom2]
    }
}; foreach p { frame frameView } {send $p addCallback cpDisplayFrameData}


# Frame enhancement.
# -------------------------------
set cpEnhanceDisable 0
set cpEnhanceId 0
set cpEnhanceMode none
set cpEnhanceVal 0
set cpListItem none

# Windowing the colormap is slow when the mouse is not in the image window,
# so it is necessary to execute the windowColormap in a work procedure.
# This allows any number of slider motion events to be processed for each
# windowColormap, preventing slider events from queueing up.

proc cpResetEnhance args {
    global cpListItem cpEnhanceId
    set cpListItem none
    set cpEnhanceId 0
}

proc cpSetEnhancement {widget cbtype x y} {
    global cpEnhanceMode cpEnhanceVal cpEnhanceId cpEnhanceDisable
    set cpEnhanceMode $widget
    set cpEnhanceVal $x
    if {!$cpEnhanceId && !$cpEnhanceDisable} {
	set cpEnhanceId [postWorkProc cpEnhanceProc]
    }
}
proc cpEnhanceProc args {
    global cpEnhanceMode cpEnhanceVal cpEnhanceId
    global enhancement frame maxcontrast contrastsign
    global winrange

    set val $cpEnhanceVal
    set contrast [lindex $enhancement($frame) 2]
    if {$cpEnhanceMode == "contrastSlider"} {
	if { ([info exists contrastsign($frame)] == 0) } {
	    if { $contrast >= 0 } {
		set contrastsign($frame) 1
	    } else {
	        set contrastsign($frame) -1
	    }
	}
	set contrast [expr $val * $contrastsign($frame) * $maxcontrast($frame)]
	if { $winrange == "half" } {
	    set contrast [expr $contrast * 2.0]
	}
	send client windowColormap [lindex $enhancement($frame) 1] $contrast
    } elseif {$cpEnhanceMode == "maxcontrastSlider"} {
	set oldmaxContrast $maxcontrast($frame)
	set maxcontrast($frame) [expr $val * 100.0]
	if { $maxcontrast($frame) < 5.0 } {
	    set maxcontrast($frame) 5.0
	}
	send client windowColormap [lindex $enhancement($frame) 1] \
	    [expr $contrast * ($maxcontrast($frame)/$oldmaxContrast)] 
    } else {
	send client windowColormap $val
    }

    set cpEnhanceId 0
    return done
}

proc cpInvert args {
    global enhancement frame
    global contrastsign
    global winrange

    if { ([info exists contrastsign($frame)] == 0) } {
	set contrastsign($frame) 1
    }
    if { $contrastsign($frame) == -1 } {
	set contrastsign($frame) 1
    } else {
	set contrastsign($frame) -1
    }
    set contrast [ expr [lindex $enhancement($frame) 2] * -1]
    send client windowColormap [lindex $enhancement($frame) 1] $contrast
    send invertButton set on [expr $contrastsign($frame) < 0]
}

proc cpDisplayEnhancement {param old new} {
    global cpEnhanceId cpEnhanceDisable
    global cpListItem enhancement maxcontrast frame
    global winrange

    if {!$frame} \
	return
    set enh $enhancement($frame)
    if {[llength $enh] < 3} \
	return

    set colortable [lindex $enh 0]
    set offset     [lindex $enh 1]
    set scale      [lindex $enh 2]
    if { $winrange == "half" } {
	set scale [expr $scale / 2.0]
    }
    send colordata set label [format "-- %s --"	$colortable]
    send colordata2 set label [format "Con %.3g  Brt %0.2f\n MaxCon %3.0f" \
	$scale $offset $maxcontrast($frame)]

    if {$colortable != $cpListItem} {
	send colorlist highlight $colortable
	set cpListItem $colortable
    }

    if {!$cpEnhanceId && !$cpEnhanceDisable} {
	set cpEnhanceDisable 1
	send contrastSlider moveThumb [expr abs($scale) / $maxcontrast($frame)]
	send maxcontrastSlider moveThumb [expr $maxcontrast($frame) / 100.0]
	send brightnessSlider moveThumb $offset
	set cpEnhanceDisable 0
    }
}

foreach i { enhancement frame } {
    send $i addCallback cpDisplayEnhancement
}
send contrastSlider addCallback cpSetEnhancement scroll
send maxcontrastSlider addCallback cpSetEnhancement scroll
send brightnessSlider addCallback cpSetEnhancement scroll
send invertButton addCallback cpInvert
send invert addCallback cpInvert


# Colortable display and selection.
# -------------------------------
set cpScrollHeight 0

proc cpSetColorList {param old new} {
    send colorlist setList $new resize
}; send colortables addCallback cpSetColorList

proc cpResizeScrollbar {widget cbtype flags x y w h cw ch} {
    global cpScrollHeight
    set newHeight [expr $ch - $h]
    if {$newHeight && $newHeight != $cpScrollHeight} {
	send colorlistScroll setScrollbar 0.0 [expr double($h) / $ch]
	set rowHeight [send colorlist get rowHeight]
	set rowSpacing [send colorlist get rowSpacing]
	send colorlistScroll set increment [expr ($ch <= $h) ? 0 : \
	    "double ($rowHeight + $rowSpacing) / ($ch - $h)"]
	set cpScrollHeight $newHeight
    }
}; send colorlistPort addCallback cpResizeScrollbar

proc cpScrollColorlist {widget cbtype pos} {
    global cpScrollHeight
    send colorlist set y [expr -int($cpScrollHeight * $pos)]
}; send colorlistScroll addCallback cpScrollColorlist scroll

proc cpSelectColor {widget cbtype selections indices} {
    global colortable
    foreach selection $selections {
#	send client setColormap $selection
	SetColormap $selection
    }
}; send colorlist addCallback cpSelectColor
    

# Frame blink.
# -------------------------------
send BRtext set label $blinkRate

proc cpSetBlinkRate {widget args} {
    global blinkRate
    if {$widget == "BRincrease"} {
	if {$blinkRate < 0.01} {
	    set blinkRate 0.125
	} else {
	    set blinkRate [expr $blinkRate * 2.0]
	}
    } else {
	set blinkRate [expr $blinkRate / 2.0]
	if {$blinkRate < 0.01} {
	    set blinkRate 0
	}
    }
    send BRtext set label $blinkRate
}
foreach widget { BRincrease BRdecrease } {
    send $widget addCallback cpSetBlinkRate
}

proc cpSetBlinkFrame {widget args} {
    global blinkFrames nframes

    set frame [send $widget get label]
    if {$frame == " "} {
	set frame 1
    } else {
	incr frame
	if {$frame > $nframes} {
	    set frame " "
	}
    }
    send $widget set label $frame

    set blinkFrames {}
    foreach i {1 2 3 4} {
	set frame [send blinkFrame$i get label]
	if {$frame != " "} {
	    lappend blinkFrames $frame
	}
    }
}; foreach i $frames {send blinkFrame$i addCallback cpSetBlinkFrame}

proc cpBlink {widget args} {
    global blinkRate blinkId

    if {$blinkRate < 0.01} {
	send $widget set on  0
	Blink
    } elseif {($blinkId != 0) != [send $widget get on]} {
	toggleBlink
    }
}; send blinkButton addCallback cpBlink

proc cpResetBlink args {
    global blinkRate blinkFrames blinkIndex frames
    global defaultBlinkRate

    foreach i $frames {
	send blinkFrame$i set label " "
    }
    set blinkRate $defaultBlinkRate
    send BRtext set label $blinkRate
    set blinkIndex 0
}; send blinkReset addCallback cpResetBlink

proc cpTraceBlink {name element op} {
    upvar $name blinkId
    send blinkButton set on [expr $blinkId != 0]
}; trace variable blinkId w cpTraceBlink

proc cpSetBlinkFrames {param old new} {
    global blinkFrames frames
    set blinkFrames {}
    foreach i $frames {
	if {$i <= $new} {
	    lappend blinkFrames $i
	}
    }
    cpResetBlink
    set button 1
    foreach i $blinkFrames {
	send blinkFrame$button set label $i
	incr button
    }
}; send nframes addCallback cpSetBlinkFrames

proc cpRegisterFrames args {
    global blinkFrames
    global tileframe mlist
    global registerFrame flipFrame frame
    global xflip yflip
    global frameViews

    if { $tileframe && [llength $mlist] } {
	Print "Error: sorry, we cannot register and tile with markers present!"
	Print "This will be fixed in a future revision."
	MessDisplay
	return
    }
    foreach i $blinkFrames {
        if { [info exists flipFrame($i)] && ($frame != $i) } {
	    set xflip_change [expr $xflip != [lindex $flipFrame($i) 0]]
	    set yflip_change [expr $yflip != [lindex $flipFrame($i) 1]]
	    set registerFrame($i) [list $frame $xflip_change $yflip_change]
	}
    }
    send client registerFrames \{$blinkFrames\}
}; send registerButton addCallback cpRegisterFrames

proc cpMatchFrames args {
    global blinkFrames
    send client matchFrames \{$blinkFrames\}
}; send matchButton addCallback cpMatchFrames


# Options buttons.
# -------------------------------
proc cpSetPanner {widget args} {
    setPanner [send $widget get on]
}; send pannerButton addCallback cpSetPanner

proc cpTracePanner {name element op} {
    upvar $name panner_enable
    send pannerButton set on $panner_enable
}; trace variable panner_enable w cpTracePanner

proc cpSetCoordsBox {widget args} {
    setTrack [send $widget get on]
}; send coordsBoxButton addCallback cpSetCoordsBox

proc cpTraceCoordsBox {name element op} {
    upvar $name track_enable
    send coordsBoxButton set on $track_enable
}; trace variable track_enable w cpTraceCoordsBox

proc cpSetWarnings args {
    global warnings
    set warnings [send warningsButton get on]
}; send warningsButton addCallback cpSetWarnings

proc cpSetAutoscale args {
    global tileframe mlist
    set value [send autoscaleButton get on]
    if { $value && $tileframe && [llength $mlist] } {
       Print "Error: sorry, we cannot autoscale and tile with markers present!"
       send autoscaleButton set on 0
       Print "This will be fixed in a future revision."
       MessDisplay
       return
    }
    send client setOption autoscale [expr {$value ? "True" : "False"}]
}; send autoscaleButton addCallback cpSetAutoscale

proc cpTrackAutoscale {param old new} {
    send autoscaleButton set on [true $new]
}; send autoscale addCallback cpTrackAutoscale

proc cpSetAntialias args {
    set value [send antialiasButton get on]
    send client setOption antialias [expr {$value ? "True" : "False"}]
}; send antialiasButton addCallback cpSetAntialias

proc cpTrackAntialias {param old new} {
    send antialiasButton set on [true $new]
}; send antialias addCallback cpTrackAntialias

proc cpSetTileFrames args {
    global blinkFrames tileframe autocf
    global blinkId blinkRate blinkIndex
    global frame blinkframe

    set value [send tileFramesButton get on]
    HideMlist
    send client setOption tileFrames \
	[expr {$value ? "True" : "False"}] \{ $blinkFrames \}
    set tileframe [expr {$value ? 1 : 0}]
    editMenu frameMenu toplevel [makeframeMenuDescription]
    ReBland frameMenu
    TileMlist $value
}; send tileFramesButton addCallback cpSetTileFrames

proc cpSetAutoTile args {
    global blinkFrames autotile autocf
    global blinkId blinkRate blinkIndex
    global frame blinkframe

    set value [send autoTileButton get on]
    set autotile [expr {$value ? 1 : 0}]
}; send autoTileButton addCallback cpSetAutoTile

proc cpTrackTileFrames {param old new} {
    send tileFramesButton set on [true $new]
}; send tileFrames addCallback cpTrackTileFrames

proc cpSetMagnifier {widget args} {
    setMagnifier [send $widget get on]
}; send magnifierButton addCallback cpSetMagnifier

proc cpTraceMagnifier {name element op} {
    upvar $name magnifier_enable
    send magnifierButton set on $magnifier_enable
}; trace variable magnifier_enable w cpTraceMagnifier


proc toggleTileFrames args {
    global blinkId blinkRate blinkIndex
    global frame blinkframe
    global tileframe

    set tileframe [expr {$tileframe ? 0 : 1}]
    send tileFramesButton set on $tileframe
    cpSetTileFrames
}

# Warning dialog.  This pops up a dialog box with the given warning message,
# and executes the given command if the user pushes OK.

set Wcommand ""

proc Wexec {command msg} {
    global Wcommand
    set Wcommand $command
    send warnText set label $msg
    send SAOtngWarning unmap
    send SAOtngWarning map
}

proc Wbutton {widget args} {
    global Wcommand
    if {$widget == "warnOk"} {
	send server $Wcommand
    }
    send SAOtngWarning unmap
}; foreach w { warnOk warnCancel } {send $w addCallback Wbutton}


# Global control panel buttons.
# -------------------------------
proc cpInitialize args {
    BusyCursor
    send imagewin setCursorType busy
    send client initialize
    IdleCursor
}
send initializeButton addCallback cpInitialize
send normalizeButton addCallback normalize

#
#
# Help
#

set help_up 0

if { [info exists env(SAOTNG_HELPPAGE)] } {
    set default_help $env(SAOTNG_HELPPAGE)
} else {
    set default_help "help.html"
}

# history information
set prevstack ""
set nextstack ""
set curpage $default_help

# ToggleHelp -- Toggle control help display.
proc ToggleHelp args {
    global help_up
    if {$help_up} {
	send SAOtngHelp unmap
	set help_up 0
    } else {
	send SAOtngHelp map
	set help_up 1
    }
}
send helpButton addCallback ToggleHelp

# HelpDone -- bring down a help display
proc HelpDone args {
    global help_up
    send SAOtngHelp unmap
    set help_up 0
}; send helpDone addCallback HelpDone

# HelpReset -- reset the help window to the top level
proc HelpReset args {
    global default_help
    global prevstack nextstack curpage
    # insert curpage into prevstack
    set prevstack [linsert $prevstack 0 $curpage]
    # load the default home page
    HelpFile $default_help no
    send nexturlLabel set label " "
}; send helpReset addCallback HelpReset

# HelpBack -- get the previous help file
proc HelpBack args {
    global prevstack nextstack curpage
	
    if { [llength $prevstack] > 0 } {
	# insert curpage into nextstack
	set nextstack [linsert $nextstack 0 $curpage]
	# pop of url from previous stack
        set url [lindex $prevstack 0]
	set prevstack [lrange $prevstack 1 end]
	# load the url removed from the stack
        HelpFile $url no
        send nexturlLabel set label " "
    } else {
	Print "Beginning of help history list!"
    }
}; send helpBack addCallback HelpBack

# HelpForw -- get the next help file
proc HelpForw args {
    global prevstack nextstack curpage

    if { [llength $nextstack] > 0 } {
	# insert curpage into prevstack
	set prevstack [linsert $prevstack 0 $curpage]
	# pop of url from next stack	
	set url [lindex $nextstack 0]
	set nextstack [lrange $nextstack 1 end]
	# load the url removed from the stack
        HelpFile $url no
        send nexturlLabel set label " "
    } else {
	Print "End of help history list!"
    }
}; send helpForw addCallback HelpForw

# HelpFile -- load a new help file
proc HelpFile {filename {addhist "no"}} {
    global env xpafd
    global prevstack nextstack curpage

    # split filename into a url and a section ...
    if { [string range $filename 0 0] == "#" } {
	set ind [string first # $curpage]
	if { $ind >=0 } {
	    set url [string range $curpage 0 [expr $ind - 1]]
	} else {
	    set url $curpage
	}
	set section [string range $filename 1 end]
    # look for a section within another file
    } else {
	set ind [string first # $filename]
	if { $ind >=0 } {
	    set url [string range $filename 0 [expr $ind - 1]]
	    set section  [string range $filename [expr $ind + 1] end]
	} else {
	    set url $filename
	    set section ""
	}
    }

    # first look for the in the current directory, 
    # then look in the user help directory,
    # then the default help directory
    if { [file exists $url] == 0 } {
	if { [info exists env(SAOTNG_HELPUSERDIR)] } {
	    set pathname $env(SAOTNG_HELPUSERDIR)
	    set len [expr [string length $pathname] - 1]
	    if { [string index $pathname $len] != "/" } {
		set pathname [format "%s/" $pathname]
	    }
	    set nurl [format "%s%s" $pathname $url]
	    if { [file exists $nurl] } {
		set url $nurl
	    }
	}
        if { [file exists $url] == 0 } {
	    if { [info exists env(SAOTNG_HELPDIR)] } {
	        set pathname $env(SAOTNG_HELPDIR)
		set len [expr [string length $pathname] - 1]
		if { [string index $pathname $len] != "/" } {
		    set pathname [format "%s/" $pathname]
		}
	        set nurl [format "%s%s" $pathname $url]
	        if { [file exists $nurl] } {
		    set url $nurl
	        }
	    }
	}
    }

    # look for a PostScript file
    set ext [file extension $url]
    if { $ext == ".ps" } {
	OpenShell
	if { $xpafd == -1 } {
	    return
	}
	puts $xpafd "ghostview $url &"
	flush $xpafd
	return
    }
    # look for a compressed file
    if { $ext == ".Z" } {
	# look for a PostScript file
	set root [file rootname $url]
        set ext [file extension $root]
	if { $ext == ".ps" } {
	    OpenShell
	    if { $xpafd == -1 } {
		return
	    }
	    puts $xpafd "(zcat $url | ghostview -) &"
	    flush $xpafd
	} else {
	    Print [format "Can't display compressed file: %s" $url]
	}
	return
    }

    # open the help file
    if { [catch {open $url r} fd] } {
	set text [format "<plaintext>ERROR: can't open help file '%s'" \
		 $filename]
	send helpText setText $text
    } else {
      set text [read $fd]
      close $fd
      if {[file extension $url] == ".html"} {
	if { $section == "" } {
	    send helpText setText $text
	} else {
	    send helpText setText $text $section
	}
      } else {
	send helpText setText "<plaintext>$text"
      }
    }
    
    # set the curpage for relative sections
    if { $section != "" } {
        set curpage [format "%s#%s" $url $section]
    } else {
        set curpage $url
    }
 
    # reset labels
    set ind [string last / $url]
    if { $ind >=0 } {
        set s [string range $url [expr $ind + 1] end]
    } else {
        set s $url
    }
    send helpLabel set label $s
    send helpText retestAnchors
    send nexturlLabel set label " "
}

# DisplayHelp -- show a help file (requested by an external process)
proc DisplayHelp { param old new } {
    global help_up
    global prevstack nextstack curpage default_help

    if { !$help_up} {
        ToggleHelp
    }
    if { $new == "home" } {
        set page $default_help
    } else {
        set page $new
    }

    # set next stack to ""
    set nextstack ""
    # insert curpage into prevstack
    set prevstack [linsert $prevstack 0 $curpage]
    # set url as visited
    set url($page) 1
    # load file
    HelpFile $page no
}; send help addCallback DisplayHelp

# Stuff for keeping track of visited anchors.
set url(0) empty

proc anchorSelected {widget cbtype event text href args} {
    global url
    global prevstack nextstack curpage

    # set nextstack to ""
    set nextstack ""
    # insert curpage into prevstack
    set prevstack [linsert $prevstack 0 $curpage]
    # set url as visited
    set url($href) 1
    # load help file
    HelpFile $href no
}

proc testAnchor {widget cbtype href} {
    global url
    return [info exists url($href)]
}

proc anchorVisited {widget cbtype href} {
    set ind [string last / $href]
    if { $ind >=0 } {
        set s [string range $href [expr $ind + 1] end]
    } else {
        set s $href
    }
    send nexturlLabel set label $s
}
send helpText addCallback anchorVisited pointerMotion
send helpText addCallback testAnchor testAnchor
send helpText addCallback anchorSelected anchor

# Test submit form callback.
proc submitFormCalled {widget cbtype event attrs href method args} {
    Print [format "\nSubmit Form to: %s\nMethod: %s\n%s\n" \
	$href $method $attrs]
}
send helpText addCallback submitFormCalled submitForm

# load the default help file
HelpFile $default_help no
send nexturlLabel set label " "

# #############################################################################
#
# routines dealing with the status line
#
# #############################################################################

set maxmesslen 20000
set messline ""
set messlen 0

# and one that sort of deals with printing ...
proc Print { s } {
    global Verbose
    if { $Verbose } {
	print $s
    }
    SetStatus "" "" [format "%s\n" $s]
}

proc SetStatus { param old new } {
    global messline messlen maxmesslen
    global Verbose

    if { $messlen > $maxmesslen } {
	set messline [format "%s\n" "Clearing message buffer ..."]
	set messlen [string length $messlen]
    }
    set messlen [expr $messlen + [string length $new]]
    set messline [format "%s%s" $messline $new]
    send messLine set string $messline
    send messLine set insertPosition $messlen
    if { !$Verbose } {
	    if { [regexp -nocase {^error.*} $new]    || \
	         [regexp -nocase {^warning.*} $new]} {
	    MessDisplay
	}
    }
}
send statusline addCallback SetStatus

set mess_up 0

# MessDisplay -- bring up a message display
proc MessDisplay args {
    global mess_up DisplayMessages
    if { [true $DisplayMessages] } {
        send SAOtngMessages map
        set mess_up 1
    }
}

# MessDone -- bring down a message display
proc MessDone args {
    global mess_up
    send SAOtngMessages unmap
    set mess_up 0
}; send messDone addCallback MessDone

# ToggleMessages -- Toggle control help display.
proc ToggleMessages args {
    global mess_up
    if {$mess_up} {
	send SAOtngMessages unmap
	set mess_up 0
    } else {
	send SAOtngMessages map
	set mess_up 1
    }
}

# MessClear -- clear the message screen
proc MessClear args {
    global messline
    set messline ""
    send messLine set string $messline
}; send messClear addCallback MessClear

if { ($DisplayMessages == "startup") || ($DisplayMessages == "Startup") || ($DisplayMessages == "STARTUP")  } {
    set DisplayMessages "true"
    MessDisplay
}

# these dummy routines are defined to work around a bug in the menu facility
# whereby an error occurs if you pull down a walking menu entry and release
# on the entry without choosing one of the walking menu options
proc analMenu args {}
proc annotateMenu args {}
proc scalelimsMenu args {}
proc blandMenu args {}
proc blockingFunc args {}
proc blockingMenu args {}
proc colorMenu args {}
proc cursorMenu args {}
proc fileMenu args {}
proc frameMenu args {}
proc magzoomMenu args {}
proc markerAnalMenu args {}
proc markerColor args {}
proc markerIE args {}
proc markerMenu args {}
proc markerShape args {}
proc markerType args {}
proc panMenu args {}
proc panmagMenu args {}
proc panmagMenu2 args {}
proc regionColorMenu args {}
proc regionNameMenu args {}
proc regionShapeMenu args {}
proc scaleMenu args {}
proc scaleMarkerMenu args {}
proc textMarkerMenu args {}
proc wcsColorMenu args {}
proc wcsMenu args {}
proc wcsSysMenu args {}

# finally, print out the welcome message
if { [info exists env(SAOTNG_WELCOME)] } {
  Print "     "
  Print $env(SAOTNG_WELCOME)
}