xgdialogs250.tcl

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

proc EntryIntegerProc { window key } \
{
	switch $key {
	"0" -
	"1" -
	"2" -
	"3" -
	"4" -
	"5" -
	"6" -
	"7" -
	"8" -
	"9" -
	"0" { $window insert insert $key }
	"minus" { $window insert insert - }
	"Delete" -
	"BackSpace" { $window delete [expr [$window index insert] - 1] }
	}

	}

proc EntryFloatProc { window key } \
{
	switch $key {
	"0" -
	"1" -
	"2" -
	"3" -
	"4" -
	"5" -
	"6" -
	"7" -
	"8" -
	"9" -
	"0" -
	"e" -
	"E" { $window insert insert $key }
	"period" { $window insert insert . }
	"minus" { $window insert insert - }
	"Delete" -
	"BackSpace" { $window delete [expr [$window index insert] - 1] }
	}

}

proc EntryControlProc { window key } \
{
	switch $key {
	"a" { $window icursor 0 }
	"b" { $window icursor [expr [$window index insert] - 1] }
	"d" { $window delete [$window index insert] }
	"e" { $window icursor end }
	"f" { $window icursor [expr [$window index insert] + 1] }
	"h" { $window delete [expr [$window index insert] - 1] }
	}

}

proc CreateInputFileDialog { } \
{
	global InputFile
	global InputFileCreated
	global XGrafixIcon

	toplevel .inputfile
	
	wm title .inputfile "Input File Viewer"
	wm iconbitmap . $XGrafixIcon
	wm minsize .inputfile 80 24

	label .inputfile.label -text $InputFile -relief raised
	pack .inputfile.label -fill x -ipady 3

	frame .inputfile.frame
	text .inputfile.frame.text -highlightthickness 0 -relief raised -setgrid true -wrap word \
		-bd 2 -yscrollcommand { .inputfile.frame.yscrollbar set }
	bind .inputfile.frame.text <1> { }
	bind .inputfile.frame.text <B1-Motion> { }
	bind .inputfile.frame.text <Double-1> { }
	pack .inputfile.frame.text -fill both -expand true -side left
	scrollbar .inputfile.frame.yscrollbar -highlightthickness 0 -relief raised -command \
		{ .inputfile.frame.text yview }
	pack .inputfile.frame.yscrollbar -fill y -side right
	pack .inputfile.frame -fill both -expand true

	frame .inputfile.bottom -relief raised -bd 2
	button .inputfile.bottom.close -relief raised -padx 0 -pady 0 -highlightthickness 0 -text Close -command \
		{ wm withdraw .inputfile
		  .lbframe.view configure -padx 0 -pady 0 -highlightthickness 0 -text "Open Input File" }
	pack .inputfile.bottom.close -side right -padx 3 -pady 3 -ipadx 3
	pack .inputfile.bottom -fill x

	set line [open $InputFile]
	while { [eof $line] == 0 } {
	        .inputfile.frame.text insert end [gets $line]
	        .inputfile.frame.text insert end "\n"
	}
	
	set InputFileCreated 1
}

proc ToggleButton { theButton variableName onText offText } \
{
	upvar #0 $variableName variable

	if { $variable == 0 } {
		$theButton configure -padx 0 -pady 0 -highlightthickness 0 -text $onText
		set variable 1
	} else {
		$theButton configure -padx 0 -pady 0 -highlightthickness 0 -text $offText
		set variable 0
	}
}

##########################
# The Rescale Dialog Box

proc CreateRescaleDialog { type } \
{
	global WinData
	global WaitVariable
	global XGrafixIcon
	global ThreeD
	global defaultDialogBoxGeometry
	global rescaleTitle
	global rescaleXMin
	global rescaleXMax
	global rescaleAutoX
	global rescaleYMin
	global rescaleYMax
	global rescaleAutoY
	global rescaleZMin
	global rescaleZMax
	global rescaleAutoZ

	if { $type == "3D" } {
		set RescalePath .3drescaledialog
		set xSize 209
		set ySize 408
	} else {
		set RescalePath .2drescaledialog
		set xSize 209
		set ySize 292
	}

	toplevel $RescalePath
	wm withdraw $RescalePath
	wm title $RescalePath "Rescale Dialog Box"
	wm iconbitmap $RescalePath $XGrafixIcon
	wm geometry $RescalePath $defaultDialogBoxGeometry
	wm minsize $RescalePath $xSize $ySize

	label $RescalePath.label -relief raised -textvariable rescaleTitle
	pack $RescalePath.label -fill x -ipady 3

	##############
	# The X Axis

	frame $RescalePath.xaxis -relief raised -bd 2

	frame $RescalePath.xaxis.xmax
	label $RescalePath.xaxis.xmax.label -text xmax -width 15 -anchor w
	entry $RescalePath.xaxis.xmax.entry -highlightthickness 0 -relief sunken -width 12 \
		-textvariable rescaleXMax

	bind $RescalePath.xaxis.xmax.entry <KeyPress> { set rescaleAutoX Off; EntryFloatProc %W %K; break }
	bind $RescalePath.xaxis.xmax.entry <Control-KeyPress> {
		EntryControlProc %W %K; break }
	pack $RescalePath.xaxis.xmax.label -side left
	pack $RescalePath.xaxis.xmax.entry -side left -fill x -expand true

	frame $RescalePath.xaxis.xmin
	label $RescalePath.xaxis.xmin.label -text xmin -width 15 -anchor w
	entry $RescalePath.xaxis.xmin.entry -highlightthickness 0 -relief sunken -width 12 \
		-textvariable rescaleXMin
	bind $RescalePath.xaxis.xmin.entry <KeyPress> { set rescaleAutoX Off; EntryFloatProc %W %K; break }
	bind $RescalePath.xaxis.xmin.entry <Control-KeyPress> {
		EntryControlProc %W %K break }
	pack $RescalePath.xaxis.xmin.label -side left
	pack $RescalePath.xaxis.xmin.entry -side left -fill x -expand true

	frame $RescalePath.xaxis.auto
	label $RescalePath.xaxis.auto.label -text "Autorescale X" -width 15 \
		-anchor w
	button $RescalePath.xaxis.auto.button -padx 0 -pady 0 -highlightthickness 0 -text On -width 12 \
		-command "ToggleButton $RescalePath.xaxis.auto.button \
			rescaleAutoX On Off"

	pack $RescalePath.xaxis.auto.label -side left
	pack $RescalePath.xaxis.auto.button -side left -fill both -expand true

	frame $RescalePath.xaxis.linlog
	label $RescalePath.xaxis.linlog.label -text "Scale Type" -width 15 \
		-anchor w
	button $RescalePath.xaxis.linlog.button -padx 0 -pady 0 -highlightthickness 0 -text Linear -width 12 \
		-command "ToggleButton $RescalePath.xaxis.linlog.button \
			rescaleXType Logarithmic Linear"
	pack $RescalePath.xaxis.linlog.label -side left
	pack $RescalePath.xaxis.linlog.button -side left -fill both \
		-expand true
		
	pack $RescalePath.xaxis.xmax $RescalePath.xaxis.xmin -fill x -pady 3
	pack $RescalePath.xaxis.auto $RescalePath.xaxis.linlog -fill both \
		-pady 3 -expand true
	pack $RescalePath.xaxis -fill both -expand true

	##############
	# The Y Axis

	frame $RescalePath.yaxis -relief raised -bd 2

	frame $RescalePath.yaxis.ymax
	label $RescalePath.yaxis.ymax.label -text ymax -width 15 -anchor w
	entry $RescalePath.yaxis.ymax.entry -highlightthickness 0 -relief sunken -width 12 \
		-textvariable rescaleYMax
	bind $RescalePath.yaxis.ymax.entry <KeyPress> { set rescaleAutoY Off; EntryFloatProc %W %K; break }
	bind $RescalePath.yaxis.ymax.entry <Control-KeyPress> {
		EntryControlProc %W %K; break }
	pack $RescalePath.yaxis.ymax.label -side left
	pack $RescalePath.yaxis.ymax.entry -side left -fill x -expand true

	frame $RescalePath.yaxis.ymin
	label $RescalePath.yaxis.ymin.label -text ymin -width 15 -anchor w
	entry $RescalePath.yaxis.ymin.entry -highlightthickness 0 -relief sunken -width 12 \
		-textvariable rescaleYMin
	bind $RescalePath.yaxis.ymin.entry <KeyPress> { set rescaleAutoY Off; EntryFloatProc %W %K; break }
	bind $RescalePath.yaxis.ymin.entry <Control-KeyPress> {
		EntryControlProc %W %K; break }
	pack $RescalePath.yaxis.ymin.label -side left
	pack $RescalePath.yaxis.ymin.entry -side left -fill x -expand true

	frame $RescalePath.yaxis.auto
	label $RescalePath.yaxis.auto.label -text "Autorescale Y" -width 15 \
		-anchor w
	button $RescalePath.yaxis.auto.button -padx 0 -pady 0 -highlightthickness 0 -text On -width 12 \
		-command "ToggleButton $RescalePath.yaxis.auto.button \
			rescaleAutoY On Off"
	pack $RescalePath.yaxis.auto.label -side left
	pack $RescalePath.yaxis.auto.button -side left -fill both -expand true

	frame $RescalePath.yaxis.linlog
	label $RescalePath.yaxis.linlog.label -text "Scale Type" -width 15 \
		-anchor w
	button $RescalePath.yaxis.linlog.button -padx 0 -pady 0 -highlightthickness 0 -text Linear -width 12 \
		-command "ToggleButton $RescalePath.yaxis.linlog.button \
			rescaleYType Logarithmic Linear"

	pack $RescalePath.yaxis.linlog.label -side left
	pack $RescalePath.yaxis.linlog.button -side left -fill both \
		-expand true
		
	pack $RescalePath.yaxis.ymax $RescalePath.yaxis.ymin -fill x -pady 3
	pack $RescalePath.yaxis.auto $RescalePath.yaxis.linlog -fill both \
		-pady 3 -expand true
	pack $RescalePath.yaxis -fill both -expand true

	##############
	# The Z Axis

	if { $type == "3D" } {
	frame $RescalePath.zaxis -relief raised -bd 2

	frame $RescalePath.zaxis.zmax
	label $RescalePath.zaxis.zmax.label -text zmax -width 15 -anchor w
	entry $RescalePath.zaxis.zmax.entry -highlightthickness 0 -relief sunken -width 12 \
		-textvariable rescaleZMax
	bind $RescalePath.zaxis.zmax.entry <KeyPress> { set rescaleAutoZ Off; EntryFloatProc %W %K; break }
	bind $RescalePath.zaxis.zmax.entry <Control-KeyPress> { 
		EntryControlProc %W %K; break }
	pack $RescalePath.zaxis.zmax.label -side left
	pack $RescalePath.zaxis.zmax.entry -side left -fill x -expand true

	frame $RescalePath.zaxis.zmin
	label $RescalePath.zaxis.zmin.label -text zmin -width 15 -anchor w
	entry $RescalePath.zaxis.zmin.entry -highlightthickness 0 -relief sunken -width 12 \
		-textvariable rescaleZMin
	bind $RescalePath.zaxis.zmin.entry <KeyPress> { set rescaleAutoZ Off; EntryFloatProc %W %K; break }
	bind $RescalePath.zaxis.zmin.entry <Control-KeyPress> {
		EntryControlProc %W %K; break }
	pack $RescalePath.zaxis.zmin.label -side left
	pack $RescalePath.zaxis.zmin.entry -side left -fill x -expand true

	frame $RescalePath.zaxis.auto
	label $RescalePath.zaxis.auto.label -text "Autorescale Z" -width 15 \
		-anchor w
	button $RescalePath.zaxis.auto.button -padx 0 -pady 0 -highlightthickness 0 -text On -width 12 \
		-command "ToggleButton $RescalePath.zaxis.auto.button \
			rescaleAutoZ On Off"

	pack $RescalePath.zaxis.auto.label -side left
	pack $RescalePath.zaxis.auto.button -side left -fill both -expand true

	frame $RescalePath.zaxis.linlog
	label $RescalePath.zaxis.linlog.label -text "Scale Type" -width 15 \
		-anchor w
	button $RescalePath.zaxis.linlog.button -padx 0 -pady 0 -highlightthickness 0 -text Linear -width 12 \
		-command "ToggleButton $RescalePath.zaxis.linlog.button \
			rescaleZType Logarithmic Linear"

	pack $RescalePath.zaxis.linlog.label -side left
	pack $RescalePath.zaxis.linlog.button -side left -fill both \
		-expand true
		
	pack $RescalePath.zaxis.zmax $RescalePath.zaxis.zmin -fill x -pady 3
	pack $RescalePath.zaxis.auto $RescalePath.zaxis.linlog -fill both \
		-pady 3 -expand true
	pack $RescalePath.zaxis -fill both -expand true
	}

	#####################
	# Some key bindings

	MakeBindings $RescalePath $RescalePath.xaxis.xmax.entry \
		$RescalePath.xaxis.xmin.entry "entry2entry"
	MakeBindings "" $RescalePath.xaxis.xmin.entry \
		$RescalePath.xaxis.auto.button "entry2button"
	MakeBindings $RescalePath $RescalePath.xaxis.auto.button \
		$RescalePath.xaxis.linlog.button "button2button"
	MakeBindings "" $RescalePath.xaxis.linlog.button \
		$RescalePath.yaxis.ymax.entry "button2entry"

	MakeBindings $RescalePath $RescalePath.yaxis.ymax.entry \
		$RescalePath.yaxis.ymin.entry "entry2entry"
	MakeBindings "" $RescalePath.yaxis.ymin.entry \
		$RescalePath.yaxis.auto.button "entry2button"
	MakeBindings $RescalePath $RescalePath.yaxis.auto.button \
		$RescalePath.yaxis.linlog.button "button2button"

	if { $type != "3D" } {
		MakeBindings "" $RescalePath.yaxis.linlog.button \
			$RescalePath.xaxis.xmax.entry "button2entry"
	} else {
		MakeBindings "" $RescalePath.yaxis.linlog.button \
			$RescalePath.zaxis.zmax.entry "button2entry"
		MakeBindings $RescalePath $RescalePath.zaxis.zmax.entry \
			$RescalePath.zaxis.zmin.entry "entry2entry"
		MakeBindings "" $RescalePath.zaxis.zmin.entry \
			$RescalePath.zaxis.auto.button "entry2button"
		MakeBindings $RescalePath $RescalePath.zaxis.auto.button \
			$RescalePath.zaxis.linlog.button "button2button"
		MakeBindings "" $RescalePath.zaxis.linlog.button \
			$RescalePath.xaxis.xmax.entry "button2entry"
	}

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

	frame $RescalePath.bottom -relief raised -bd 2
	button $RescalePath.bottom.apply -padx 0 -pady 0 -highlightthickness 0 -text Apply -command { \
		set Changed 1
		Rescale new
		GetRanges}
	button $RescalePath.bottom.ok -padx 0 -pady 0 -highlightthickness 0 -text Ok -command " \
		[list RescaleButtonProc $RescalePath new ] "
	button $RescalePath.bottom.cancel -padx 0 -pady 0 -highlightthickness 0 -text Cancel -command " \
		[list RescaleButtonProc $RescalePath old ] "
	pack $RescalePath.bottom.cancel $RescalePath.bottom.ok \
		$RescalePath.bottom.apply -side right -padx 3 -pady 3 -ipadx 3
	pack $RescalePath.bottom -fill x
}

proc RescaleButtonProc { path type } \
{
	global WaitVariable
	global Changed
	global rescaleWindowPath
	global WinData
	global VectorD

	set WaitVariable 1
	wm withdraw $path
	grab release $path
        #focus .list.top.entry
        
	set Window $rescaleWindowPath
	if { $WinData($Window,type) == $VectorD } {
		pack .2drescaledialog.xaxis.linlog \
			.2drescaledialog.yaxis.linlog -pady 3
	}

	if { [string compare $type new] == 0 } {
		Rescale new
		SetRescale
	} else {
		if { $Changed == 1 } {
			Rescale old
			set Changed 0
		}
	}

	$rescaleWindowPath.bframe.rescale configure -relief raised
}

proc SetButtonString { theButton variable onText offText } \
{
	if { $variable == 0 } {
		$theButton configure -padx 0 -pady 0 -highlightthickness 0 -text $offText
	} else {
		$theButton configure -padx 0 -pady 0 -highlightthickness 0 -text $onText
	}
}

#################################################
# Backing up the data in case Cancel is pressed

proc GetRanges { } \
{
	global WinData
	global rescaleTitle
	global rescaleXMin
	global rescaleXMax
	global rescaleAutoX
	global rescaleXType
	global rescaleYMin
	global rescaleYMax
	global rescaleAutoY
	global rescaleYType
	global rescaleZMin
	global rescaleZMax
	global rescaleAutoZ
	global rescaleZType
	global rescaleWindowPath
	global ThreeD

	set Window $rescaleWindowPath
	if { $WinData($rescaleWindowPath,type) == $ThreeD } {
		set rescaleWindow .3drescaledialog
	} else {
		set rescaleWindow .2drescaledialog
	}

	set values [C_GetRanges $WinData($Window,index)]

	set rescaleXMin [lindex $values 0]
	set rescaleXMax [lindex $values 1]
	set rescaleAutoX [lindex $values 2]
	set rescaleXType [lindex $values 3]
	SetButtonString $rescaleWindow.xaxis.auto.button $rescaleAutoX On Off
	SetButtonString $rescaleWindow.xaxis.linlog.button $rescaleXType \
		Logarithmic Linear

	set rescaleYMin [lindex $values 4]
	set rescaleYMax [lindex $values 5]
	set rescaleAutoY [lindex $values 6]
	set rescaleYType [lindex $values 7]
	SetButtonString $rescaleWindow.yaxis.auto.button $rescaleAutoY On Off
	SetButtonString $rescaleWindow.yaxis.linlog.button $rescaleYType \
		Logarithmic Linear

	if { $WinData($rescaleWindowPath,type) == $ThreeD } {
		set rescaleZMin [lindex $values 8]
		set rescaleZMax [lindex $values 9]
		set rescaleAutoZ [lindex $values 10]
		set rescaleZType [lindex $values 11]
		SetButtonString $rescaleWindow.zaxis.auto.button \
			$rescaleAutoZ On Off
		SetButtonString $rescaleWindow.zaxis.linlog.button \
			$rescaleZType Logarithmic Linear
	}
}

#######################################################
# Restoring the backed up data when Cancel is pressed

proc SetRescale { } \
{
	global WinData
	global rescaleWindowPath
	global rescaleXMin
	global rescaleXMax
	global rescaleAutoX
	global rescaleXType
	global rescaleYMin
	global rescaleYMax
	global rescaleAutoY
	global rescaleYType
	global rescaleZMin
	global rescaleZMax
	global rescaleAutoZ
	global rescaleZType
	global ThreeD

	set Window $rescaleWindowPath

	set WinData($Window,xMin) $rescaleXMin
	set WinData($Window,xMax) $rescaleXMax
	set WinData($Window,xAuto) $rescaleAutoX
	set WinData($Window,xLinLog) $rescaleXType

	set WinData($Window,yMin) $rescaleYMin
	set WinData($Window,yMax) $rescaleYMax
	set WinData($Window,yAuto) $rescaleAutoY
	set WinData($Window,yLinLog) $rescaleYType

	set WinData($Window,zMin) $rescaleZMin
	set WinData($Window,zMax) $rescaleZMax
	set WinData($Window,zAuto) $rescaleAutoZ
	set WinData($Window,zLinLog) $rescaleZType

	if { $WinData($Window,type) != $ThreeD } {
		if { $rescaleAutoX == 1 || $rescaleAutoY == 1 } {
			$Window.bframe.trace configure -state disabled
		} else {
			$Window.bframe.trace configure -state normal
		}
	}
}

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

proc Rescale { type } \
{
	global WinData
	global rescaleXMin
	global rescaleXMax
	global rescaleAutoX
	global rescaleXType
	global rescaleYMin
	global rescaleYMax
	global rescaleAutoY
	global rescaleYType
	global rescaleZMin