xgdialogs250.tcl

xgrafix 是PTSG模拟程序中的图形截面库 改版本是最新版本

		3dView new
	} else {
		if { $Changed == 1 } {
			3dView old
			set Changed 0
		}
	}

	$3dWindowPath.bframe.3dview configure -relief raised
}

#################################################
# Pops up the 3D Dialog Box, stopping if needed 

proc Popup3d { Window } \
{
	global WinData
	global WaitVariable
	global 3dTitle
	global 3dTheta
	global 3dPhi
	global 3dShading
	global 3dColor
	global 3dGrid
	global 3dWindowPath
	global WasRunning

	set 3dTitle $WinData($Window,title)
	set 3dTheta $WinData($Window,theta)
	set 3dPhi $WinData($Window,phi)
	set 3dShading $WinData($Window,shading)
	set 3dColor $WinData($Window,color)
	set 3dGrid $WinData($Window,grid)
	set 3dWindowPath $Window

	SetButtonString .3ddialog.middle.shading.button $3dShading On Off
	SetButtonString .3ddialog.middle.color.button $3dColor On Off
	SetButtonString .3ddialog.middle.grid.button $3dGrid On Off

	$3dWindowPath.bframe.3dview configure -relief sunken

	if { $WasRunning == 1 } {
		C_Stop
	}

	set 3dPath .3ddialog
	wm deiconify $3dPath
	focus $3dPath.middle.theta.entry
	grab set $3dPath
	
	if { $WasRunning == 1 } {
		set WaitVariable 0
		tkwait variable WaitVariable
		if { $WaitVariable == 1 } {
			C_Run
		}
	}
}

####################
# Restores 3D Data

proc Set3D { } \
{
	global WinData
	global 3dTheta
	global 3dPhi
	global 3dShading
	global 3dColor
	global 3dGrid
	global 3dWindowPath

	set WinData($3dWindowPath,theta) $3dTheta
	set WinData($3dWindowPath,phi) $3dPhi
	set WinData($3dWindowPath,shading) $3dShading
	set WinData($3dWindowPath,color) $3dColor
	set WinData($3dWindowPath,grid) $3dGrid
}

#######################################
# Use a C procedure to do the 3D stuff

proc 3dView { type } \
{
	global WinData
	global 3dTheta
	global 3dPhi
	global 3dShading
	global 3dColor
	global 3dGrid
	global 3dWindowPath

	if { $type == "new" } {
		C_3DView $WinData($3dWindowPath,index) $3dTheta $3dPhi \
			$3dShading $3dColor $3dGrid
	} else {
		C_3DView $WinData($3dWindowPath,index) \
			$WinData($3dWindowPath,theta) \
	                $WinData($3dWindowPath,phi) \
			$WinData($3dWindowPath,shading) \
        	        $WinData($3dWindowPath,color) \
			$WinData($3dWindowPath,grid)
	}
}

#######################
# The Save Dialog Box 

proc CreateSaveDialog {} \
{
	global SaveFile
	global WaitVariable
	global XGrafixIcon
	global defaultDialogBoxGeometry

	set SavePath .save
	
	toplevel $SavePath
	wm withdraw $SavePath
	wm title $SavePath "Save Dialog Box"
	wm iconbitmap $SavePath $XGrafixIcon
	wm geometry $SavePath $defaultDialogBoxGeometry
	wm minsize $SavePath 263 92
	
	label $SavePath.label -relief raised -text "Dumping the present \
		state into a file"
	pack $SavePath.label -fill x -ipady 3

	#######################
	# The Save Dialog Box  

	frame $SavePath.middle -relief raised -bd 2
	label $SavePath.middle.label -width 15 -text "File name" -anchor w
	entry $SavePath.middle.entry -width 20 -highlightthickness 0 -relief sunken \
		-textvariable SaveFile
	bind $SavePath.middle.entry <Control-KeyPress> { EntryControlProc \
		%W %K; break }
	pack $SavePath.middle.label -side left -pady 3
	pack $SavePath.middle.entry -side left -pady 3 -fill x -expand true
	pack $SavePath.middle -fill both -expand true

	#############################
	# The Ok and Cancel buttons 

	frame $SavePath.bottom -relief raised -bd 2
	button $SavePath.bottom.apply
	button $SavePath.bottom.ok -padx 0 -pady 0 -highlightthickness 0 -text Ok -command " \
		 [list SaveButton $SavePath ]
		  [list Save] "
	button $SavePath.bottom.cancel -padx 0 -pady 0 -highlightthickness 0 -text Cancel -command " \
		 [list SaveButton $SavePath ]
		  [list RestoreSaveData] "
	pack $SavePath.bottom.cancel $SavePath.bottom.ok -side right \
		-padx 3 -pady 3 -ipadx 3
	pack $SavePath.bottom -fill x

	##############################
	# Key bindings for the entry  

	MakeBindings $SavePath $SavePath.middle.entry \
		$SavePath.middle.entry "entry2entry"
}

proc SaveButton { SavePath } \
{
	global WaitVariable

	.lbframe.save configure -relief raised

	set WaitVariable 1
	wm withdraw $SavePath
	grab release $SavePath
	#focus .list.top.entry
}

#########################################
# Calls a C procedure to do the dumping

proc Save {} \
{
	global SaveFile
	C_Save $SaveFile
}

###################################################
# Pops up the Save Dialog Box, stopping if needed 

proc PopupSave {} \
{
	global WaitVariable
	global WasRunning

	if { $WasRunning == 1 } {
		C_Stop
	}

	.lbframe.save configure -relief sunken

	BackupSaveData
	wm deiconify .save
	focus .save.middle.entry
	grab set .save

	if { $WasRunning == 1 } {
		set WaitVariable 0
		tkwait variable WaitVariable
		if { $WaitVariable == 1 } {
			C_Run
		}
	}		
}

############################
# Backing up the Save data

proc BackupSaveData {} \
{
	global SaveFileOld
	global SaveFile

	set SaveFileOld $SaveFile
}

###########################
# Restoring the save data 

proc RestoreSaveData {} \
{
	global SaveFileOld
	global SaveFile

	set SaveFile $SaveFileOld
}

#######################
# The Quit Dialog Box

proc CreateQuitDialog {} \
{
	global WaitVariable
	global XGrafixIcon
	global defaultDialogBoxGeometry

	set QuitPath .quit

	toplevel $QuitPath
	wm withdraw $QuitPath
	wm title $QuitPath "Quit Dialog Box"
	wm iconbitmap $QuitPath $XGrafixIcon
	wm geometry $QuitPath $defaultDialogBoxGeometry

	frame $QuitPath.top -relief raised -bd 2	
	label $QuitPath.top.label1 -text "Do you really want to exit?"
	pack $QuitPath.top.label1 -ipady 3
	pack $QuitPath.top -fill x

	##########################
	# The Yes and No buttons  

	frame $QuitPath.bottom -relief raised -bd 2
	button $QuitPath.bottom.apply
	button $QuitPath.bottom.killX -padx 0 -pady 0 -highlightthickness 0 -text "Kill Graphics" -command \
		{ C_KillGraphics }
	button $QuitPath.bottom.yes -padx 0 -pady 0 -highlightthickness 0 -text Yes -command {C_Quit ; set WaitVariable 2 ; 
		destroy .}
	button $QuitPath.bottom.no -padx 0 -pady 0 -highlightthickness 0 -text No -command \
		" [list set WaitVariable 1]
		  [list wm withdraw $QuitPath]
		  #[list focus .list.top.entry ]
		  [list grab release $QuitPath] 
		  [list .lbframe.quit configure -relief raised ] "
	pack $QuitPath.bottom.no $QuitPath.bottom.yes $QuitPath.bottom.killX \
		-side right -padx 3 -pady 3 -ipadx 3
	pack $QuitPath.bottom -fill x

	bind $QuitPath.top.label1 <Return> [list $QuitPath.bottom.yes invoke]
	bind $QuitPath.top.label1 <Escape> [list $QuitPath.bottom.no invoke]
}

###################################################
# Pops up the Quit Dialog Box, stopping if needed

proc PopupQuit {} \
{
	global WaitVariable
	global WasRunning

	if { $WasRunning == 1 } {
		C_Stop
	}

	.lbframe.quit configure -relief sunken
	wm deiconify .quit
	focus .quit.top.label1
	grab set .quit

	if { $WasRunning == 1 } {
		set WaitVariable 0
		tkwait variable WaitVariable
	        if { $WaitVariable == 1 } {
			C_Run
		}
	}
}

##########################
# The Special Dialog Box  

proc CreateSpecialDialog {} \
{
	global SpecialData
	global numberOfSpecials
	global XGrafixIcon
	global WaitVariable
	global defaultDialogBoxGeometry

	set SpecialPath .special

	toplevel $SpecialPath
	wm withdraw $SpecialPath
	wm iconbitmap $SpecialPath $XGrafixIcon
	wm title $SpecialPath "Special Dialog Box"
	wm geometry $SpecialPath $defaultDialogBoxGeometry

	frame $SpecialPath.top -relief raised -bd 2
	label $SpecialPath.top.label -text "Adjusting internal variables"
	pack $SpecialPath.top.label -ipady 3 -fill x
	pack $SpecialPath.top -fill x

	###############
	# The entries 

	frame $SpecialPath.vars -relief raised -bd 2
	for { set index 0 } { $index < $numberOfSpecials } { incr index } {
		frame $SpecialPath.vars.$index
		label $SpecialPath.vars.$index.label -width 15 -text \
			"($SpecialData($index,type)) $SpecialData($index,varName)" -anchor w
		entry $SpecialPath.vars.$index.entry -width 12 -highlightthickness 0 -relief sunken \
			-textvariable SpecialData($index,varValue)
		if { $SpecialData($index,type) == "float" || $SpecialData($index,type) == "double"} {
			bind $SpecialPath.vars.$index.entry <KeyPress> {
				EntryFloatProc %W %K; break }
		} elseif { $SpecialData($index,type) == "integer"} {
			bind $SpecialPath.vars.$index.entry <KeyPress> {
				EntryIntegerProc %W %K; break }
		}
		bind $SpecialPath.vars.$index.entry <Control-KeyPress> { \
			EntryControlProc %W %K; break }
		pack $SpecialPath.vars.$index.label $SpecialPath.vars.$index.entry \
			-side left -pady 3
		pack $SpecialPath.vars.$index
		    }
	pack $SpecialPath.vars

	################################
	# Key bindings for the entries 

	for { set index 0 } { $index < $numberOfSpecials } { incr index 2 } {
		if { [expr $index + 1] < $numberOfSpecials } {
			MakeBindings $SpecialPath \
				$SpecialPath.vars.$index.entry \
				$SpecialPath.vars.[expr $index + 1].entry \
				"entry2entry"
		}
		if { [expr $index + 2] < $numberOfSpecials } {
			MakeBindings "" \
				$SpecialPath.vars.[expr $index + 1].entry \
				$SpecialPath.vars.[expr $index + 2].entry \
				"entry2entry"
		}
	}
	MakeBindings $SpecialPath $SpecialPath.vars.[expr $numberOfSpecials - \
		1].entry $SpecialPath.vars.0.entry "entry2entry"
		
	#############################
	# The Ok and Cancel buttons  

	frame $SpecialPath.bottom -relief raised -bd 2

	button $SpecialPath.bottom.apply -padx 0 -pady 0 -highlightthickness 0 -text Apply -command \
		[ list SetNewSpecials ]
	button $SpecialPath.bottom.cancel -command \
		" [ list RestoreSpecialData ]
		  [ list SpecialButton $SpecialPath ] " -padx 0 -pady 0 -highlightthickness 0 -text Cancel
	button $SpecialPath.bottom.ok -command \
		" [ list SpecialButton $SpecialPath ] " -padx 0 -pady 0 -highlightthickness 0 -text Ok
	pack $SpecialPath.bottom.cancel $SpecialPath.bottom.ok \
		$SpecialPath.bottom.apply -side right -padx 3 -pady 3 -ipadx 3

	pack $SpecialPath.bottom -fill x

	.lbframe.special configure -command { PopupSpecial }
	pack .lbframe.special -fill both -expand true -ipady 3
}

proc SpecialButton { SpecialPath } \
{
	global WaitVariable

	set WaitVariable 1
	wm withdraw $SpecialPath
	#focus .list.top.entry
	grab release $SpecialPath
	SetNewSpecials
	.lbframe.special configure -relief raised
}

proc BackupSpecialData {} \
{
	global SpecialData

	set index 0
	foreach value [C_GetSpecialValues] {
		set SpecialData($index,varValueOld) $value
		set SpecialData($index,varValue) $value
		incr index
	}
}

proc RestoreSpecialData {} \
{
	global SpecialData
	global numberOfSpecials

	for {set index 0} {$index < $numberOfSpecials} {incr index} {
		set SpecialData($index,varValue) $SpecialData($index,varValueOld)
	}
}
		

######################################################
# Pops up the Special Dialog Box, stopping if needed 

proc PopupSpecial {} \
{
	global WaitVariable
	global WasRunning

	###########################################
	# Gets the current value of each variable 
	BackupSpecialData

	.lbframe.special configure -relief sunken
	if { $WasRunning == 1 } {
		C_Stop
	}

	wm deiconify .special
	focus .special.vars.0.entry
	grab set .special

	if { $WasRunning == 1 } {
		set WaitVariable 0
		tkwait variable WaitVariable
		if { $WaitVariable == 1 } {
			C_Run
		}
	}		
}

######################################################################
# Procedure to make bindings for entries and buttons in dialog boxes

proc MakeBindings { Parent Widget1 Widget2 State } \
{
	if { $Parent != "" } {
	bind $Widget1 <Escape> [list $Parent.bottom.cancel invoke ]
	bind $Widget1 <Return> [list $Parent.bottom.ok invoke ]
	bind $Widget1 <Tab> [list $Parent.bottom.apply invoke]
	bind $Widget2 <Escape> [list $Parent.bottom.cancel invoke ]
	bind $Widget2 <Return> [list $Parent.bottom.ok invoke ]
	bind $Widget2 <Tab> [list $Parent.bottom.apply invoke]
	}

	switch $State {
	"entry2entry" {
		bind $Widget1 <Down> "
			[list focus $Widget2 ] "
		bind $Widget1 <Left> { %W icursor [expr [%W index insert] - 1]
					; break }
		bind $Widget1 <Right> { %W icursor [expr [%W index insert] + 1]
					; break }
		bind $Widget2 <Up> "
			[list focus $Widget1 ] "
		bind $Widget2 <Left> { %W icursor [expr [%W index insert] - 1]
					; break }
		bind $Widget2 <Right> { %W icursor [expr [%W index insert] + 1]
					; break }
	}
	"entry2button" {
		bind $Widget1 <Down> "
			[list focus $Widget2]
			[list $Widget2 flash]"
		bind $Widget2 <Up> "
			[list focus $Widget1]"
	}
	"button2entry" {
		bind $Widget1 <Down> "
			[list focus $Widget2]"
		bind $Widget2 <Up> "
			[list focus $Widget1]
			[list $Widget1 flash]"
	}
	"button2button" {
		bind $Widget1 <Escape> {+ break}
		bind $Widget1 <Return> {+ ; break}
		bind $Widget1 <space> {%W invoke; break}
		bind $Widget1 <Down> "
			[list focus $Widget2]
			[list $Widget2 flash]"
		bind $Widget2 <Escape> {+ ; break}
		bind $Widget2 <Return> {+ ; break}
		bind $Widget2 <space> {%W invoke; break}
		bind $Widget2 <Up> "
			[list focus $Widget1]
			[list $Widget1 flash]"
	}
	}
}