xgsetup250.tcl

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

source [info library]/init.tcl
if { $tk_version < 8.4 } { source $tk_library/tk.tcl }

source $XGrafixPath/xginit250.tcl
source $XGrafixPath/xgdialogs250.tcl

set tcl_interactive 0

proc Run { } \
{
	global WasRunning
	
	if { $WasRunning == 0 } {
		set WasRunning 1
		C_Run
		.lbframe.run configure -text Stop
	} else {
		set WasRunning 0
		C_Stop
		.lbframe.run configure -text Run
	}
}

proc InitMainMenu { WasInputFileGiven File } \
{
	global time
	global WaitVariable
	global XGrafixIcon
	global defaultMainMenuX
	global defaultMainMenuY
	global defaultMainMenuWidth
	global WasRunning
	global InputFile

        append WinTitle "Control Panel"
        wm title . $WinTitle
        wm iconbitmap . $XGrafixIcon

	set InputFile $File

	#########################
	# The Label and Buttons
	
	frame .lbframe
        frame .lbframe.inputf
        label .lbframe.inputf.label1 -text  [expr {([string length $InputFile] < 17) ? "" : "..."}] -anchor e -width [expr {([string length $InputFile] < 17) ? 0 : 3}]
label .lbframe.inputf.label2 -text $InputFile -anchor e -width [expr {([string length $InputFile] < 17) ? [string length $InputFile] : 17}]
        pack .lbframe.inputf.label1 .lbframe.inputf.label2 -side left

	frame .lbframe.lframe -relief ridge -bd 2
	label .lbframe.lframe.label1 -text "Time =" -width 5 \
		-anchor w
	label .lbframe.lframe.label2 -textvariable time -width 14 \
		-anchor w
	pack .lbframe.lframe.label1 .lbframe.lframe.label2 -side left

	button .lbframe.diags -padx 0 -pady 0 -highlightthickness 0 -text "Close Diagnostics" \
		-command { PopupDiagWin }
	button .lbframe.run -padx 0 -pady 0 -highlightthickness 0 -text Run -command { Run }
	button .lbframe.step -padx 0 -pady 0 -highlightthickness 0 -text Step -command { C_Step }
	button .lbframe.save -padx 0 -pady 0 -highlightthickness 0 -text Save -command { PopupSave }
	button .lbframe.quit -padx 0 -pady 0 -highlightthickness 0 -text Quit -command { PopupQuit }
	button .lbframe.special -padx 0 -pady 0 -highlightthickness 0 -text Special -command { C_Special }
	pack .lbframe.inputf .lbframe.lframe .lbframe.diags .lbframe.run \
		.lbframe.step .lbframe.save -fill both \
		-expand true -ipady 3

	if { $WasInputFileGiven == 1 } {
		button .lbframe.view -padx 0 -pady 0 -highlightthickness 0 -text "Open Input File" -command \
			{ ViewInputFile }
		pack .lbframe.view -fill both -expand true -ipady 3
	}

	pack .lbframe.quit -fill both -side bottom -expand true -ipady 3
	pack .lbframe -side left -fill y

	CreateRescaleDialog 3D
	CreateRescaleDialog 2D
	CreatePrintDialog
	Create3dDialog
	CreateSaveDialog
	CreateQuitDialog
	CreateListBox $defaultMainMenuX $defaultMainMenuY

	bind . <Enter> { focus %W; break}
}

proc ViewInputFile { } \
{
	global InputFile
	global InputFileCreated
	global WasRunning

	if { $InputFileCreated == 0 } {
		if { $WasRunning == 1 } {
			C_Stop
		}
		CreateInputFileDialog
		.lbframe.view configure -text "Close Input File"
		update idletasks
		if { $WasRunning == 1 } {
			C_Run
		}
	} else {
		if { [ wm state .inputfile ] == "withdrawn" } {
			wm deiconify .inputfile
			raise .inputfile
			.lbframe.view configure -text "Close Input File"
		} else {
			wm withdraw .inputfile
			.lbframe.view configure -text "Open Input File"
		}
	}
}

proc ScrollProc args  \
{
     #C_printf $args
     #C_printf [llength $args]
     if { [llength $args] == "3" } {
         set a [ lindex $args 0 ]
         set b [ lindex $args 1 ]
         set c [ lindex $args 2 ]
	 #C_printf $a
	 #C_printf $b
	 #C_printf $c
	 .list.lframe.openbox yview $a $b $c
         .list.lframe.listbox yview $a $b $c
     } else {
         set a [ lindex $args 0 ]
         set b [ lindex $args 1 ]
         #C_printf $a
	 #C_printf $b
	 .list.lframe.openbox yview $a $b
         .list.lframe.listbox yview $a $b
     }
 }
proc EntryKeyPressProc { key1 key2 } \
{
	switch $key1 {
	"Return" 	{ .list.buttons.open invoke ; return }
	"Up"            { ListboxScroll single up ; return }
	"Down"          { ListboxScroll single down ; return }
"Prior" { ListboxScroll page prior ; return }
"Next" { ListboxScroll page next ; return }
	"Shift_L"	-
	"Shift_R"	-
	"Control_L"	-
	"Control_R"	-
	"Escape"	-
	"Tab"		{ return }
	"Left"		{ .list.top.entry icursor [expr [.list.top.entry \
				index insert] - 1] 
			   return }
	"Right"		{ .list.top.entry icursor [expr [.list.top.entry \
				index insert] + 1]
			  return }
	"Delete" 	-
	"BackSpace"	{ .list.top.entry delete [expr [.list.top.entry \
				index insert] - 1]
			  ListboxSearch
			  return }

	}

#	.list.top.entry insert index $key2
	.list.top.entry insert insert $key2
        ListboxSearch
}


##############################
# The listbox of diagnostics 

proc CreateListBox { WinPosX WinPosY } {
	global XGrafixIcon

	toplevel .list
	wm title .list Diagnostics
	wm minsize .list 0 0
	wm iconbitmap .list $XGrafixIcon

	####################
	# The search entry  

	frame .list.top -relief raised -bd 2
	label .list.top.label -text Search:
	entry .list.top.entry -highlightthickness 0 -relief sunken -textvariable SearchVar

	pack .list.top.label -side left -pady 3
	pack .list.top.entry -side right -fill x -expand true -pady 3
	pack .list.top -fill both
	
	focus .list.top.entry
	bind .list.top.entry <KeyPress> { EntryKeyPressProc %K %A; break }
	#bind .list.top.entry <KeyPress> { ListboxSearch }
	bind .list.top.entry <Control-KeyPress> { 
		EntryControlProc %W %K 
		if { "%K" == "d" } {
			ListboxSearch
		}; break
	}

	#############################
	# The listbox and scrollbar

	frame .list.lframe
##	listbox .list.lframe.openbox -highlightthickness 0 -relief raised -yscroll { .list.lframe.scroll set } -geometry 2x10
        #listbox .list.lframe.openbox -highlightthickness 0 -relief raised -yscroll { .list.lframe.scroll set } -width 2 -height 10
        listbox .list.lframe.openbox -highlightthickness 0 -relief raised -width 2 -height 10
	#bind .list.lframe.openbox <1> { }
	#bind .list.lframe.openbox <B1-Motion> { }
	#bind .list.lframe.openbox <B2-Motion> { }	

	listbox .list.lframe.listbox -selectmode extended -highlightthickness 0 -relief raised -yscroll { .list.lframe.scroll set }
	#bind .list.lframe.listbox <B2-Motion> { }

	scrollbar .list.lframe.scroll -highlightthickness 0 -relief raised \
 -command { ScrollProc }
        bind .list.lframe.scroll <B1-Motion> { tkScrollDragCuston %W %x %y; break}
        bind .list.lframe.scroll <B2-Motion> { tkScrollDragCuston %W %x %y; break}
	bind .list.lframe.scroll <Home> { break }
	bind .list.lframe.scroll  <End> { break }
	pack .list.lframe.openbox -side left -fill y
	pack .list.lframe.listbox -side left -fill both -expand true
	pack .list.lframe.scroll -side right -fill y
	pack .list.lframe -fill both -expand true

	frame .list.buttons -relief raised -bd 2

	#################################
	# The open and closeall buttons

	button .list.buttons.open -padx 0 -pady 0 -highlightthickness 0 -text "Open" -command { PopupDiag }
	button .list.buttons.closeall -padx 0 -pady 0 -highlightthickness 0 -text "Close All" \
		-command { CloseAllDiags }

	pack .list.buttons.closeall .list.buttons.open -side right -padx 3 \
		-pady 3 -ipadx 3
	pack .list.buttons -fill x

	bind .list.lframe.listbox <Double-1> { PopupDiag; break }
	bind .list.lframe.listbox <3> [bind Listbox <1>]
	bind .list.lframe.listbox <Double-3> { CloseDiag; break }
	bind .list.lframe.listbox <Shift-1> { }
	bind .list <Enter> { focus .list.top.entry; break }
}

proc ListboxScroll { type direction } \
{
	set scrollUnits [ .list.lframe.scroll get ]
	set totalUnits [ lindex $scrollUnits 0 ]
	set windowUnits [ lindex $scrollUnits 1 ]
	set firstUnit [ lindex $scrollUnits 2 ]
	set lastUnit [ lindex $scrollUnits 3 ]
	#if { [ .list.lframe.listbox curselection ] == "" } {
	#	.list.lframe.listbox select adjust 0
	#}

	if {$type == "single"} {
		set increment 1
	} else {
		set increment $windowUnits
	}

	switch $direction {
	"down" { .list.lframe.listbox selection clear 0 [.list.lframe.listbox size]
	        .list.lframe.listbox activate [expr \
		[.list.lframe.listbox index active] + $increment] 
	        .list.lframe.listbox selection set active
	        .list.lframe.listbox yview active 
		.list.lframe.openbox yview [.list.lframe.listbox index active]}
	"up" { .list.lframe.listbox selection clear 0 [.list.lframe.listbox size] 
		.list.lframe.listbox activate [expr \
		[.list.lframe.listbox index active] -  $increment]
                .list.lframe.listbox selection set active
		.list.lframe.listbox yview active
		.list.lframe.openbox yview [.list.lframe.listbox index active]}
	"prior" {.list.lframe.listbox yview moveto [expr [ expr 2*[ lindex [ \
		.list.lframe.listbox yview] 0] ] - [ lindex [ \
		.list.lframe.listbox yview] 1] ] 
	        .list.lframe.openbox yview moveto [expr [ expr 2*[ lindex [ \
		.list.lframe.openbox yview] 0] ] - [ lindex [ \
		.list.lframe.openbox yview] 1] ] }
	"next" { .list.lframe.listbox yview moveto [ lindex [ \
		.list.lframe.listbox yview] 1] 
	        .list.lframe.openbox yview moveto [ lindex [ \
		.list.lframe.openbox yview] 1] }
    }
}


proc ListboxSearch { } \
{
	global SearchVar

#C_printf [.list.lframe.listbox curselection]
#foreach index [.list.lframe.listbox curselection] {
#    .list.lframe.listbox selection clear  $index
#}
	for {set index 0} {$index < [.list.lframe.listbox size]} {incr index} {
		if { [string match $SearchVar* [.list.lframe.listbox get $index]] == 1 } {
			foreach index2 [.list.lframe.listbox curselection] {
			    .list.lframe.listbox selection clear  $index2
			}
			# changed "from" to "set" below  --- djc for tk4
		        # .list.lframe.listbox select clear end
		        .list.lframe.listbox select set $index
			.list.lframe.listbox yview $index
			.list.lframe.openbox yview $index
			return
		}
	}
}

######################################################
# Sets up data structure for each diagnostics window

proc SetupWindow { WinName State WinPosULX WinPosULY \
	WinType xMin xMax xAuto yMin yMax yAuto zMin zMax zAuto \
	PSFile theta phi shading color grid xlog ylog zlog DumpFile xlabel \
	ylabel } \
{
	global WinData
	global SaveFile
	global default3DHeight
	global default3DWidth
	global defaultVectorHeight
	global defaultVectorWidth
	global defaultWinHeight
	global defaultWinWidth
	global TwoD
	global ThreeD
	global VectorD
	global openWindowsList

	switch $WinType \
	$TwoD { set WinWidth $defaultWinWidth
		set WinHeight $defaultWinHeight } \
	$ThreeD { set WinWidth $default3DWidth
		  set WinHeight $default3DHeight } \
	$VectorD { set WinWidth $defaultVectorWidth
		   set WinHeight $defaultVectorHeight }

	append Window . [string tolower $WinName]
	append Geometry $WinWidth x $WinHeight + $WinPosULX + $WinPosULY
	set WinData($Window,geometry) $Geometry
	set WinData($Window,type) $WinType
	set WinData($Window,title) $WinName
	set WinData($Window,open) 0
	set WinData($Window,xMin) $xMin
	set WinData($Window,xMax) $xMax
	set WinData($Window,xAuto) $xAuto
	set WinData($Window,xLinLog) $xlog		  
	set WinData($Window,yMin) $yMin
	set WinData($Window,yMax) $yMax
	set WinData($Window,yAuto) $yAuto
	set WinData($Window,yLinLog) $ylog		  
	set WinData($Window,zMin) $zMin
	set WinData($Window,zMax) $zMax
	set WinData($Window,zAuto) $zAuto
	set WinData($Window,zLinLog) $zlog		  
	set WinData($Window,origxMin) $xMin
	set WinData($Window,origxMax) $xMax
	set WinData($Window,origxAuto) $xAuto
	set WinData($Window,origxLinLog) $xlog		  
	set WinData($Window,origyMin) $yMin
	set WinData($Window,origyMax) $yMax
	set WinData($Window,origyAuto) $yAuto
	set WinData($Window,origyLinLog) $ylog		  
	set WinData($Window,origzMin) $zMin
	set WinData($Window,origzMax) $zMax
	set WinData($Window,origzAuto) $zAuto
	set WinData($Window,origzLinLog) $zlog		  
	set WinData($Window,trace) 0
	set WinData($Window,PSFile) $PSFile
	set WinData($Window,plot_title) $WinName
	set WinData($Window,printType) eps
	set WinData($Window,printMode) overwrite
	set WinData($Window,printLimit) 0
	set WinData($Window,printPeriod) 0
	set WinData($Window,printNumber) 1
	set WinData($Window,printSetStep) 0
	set WinData($Window,xCoord) 0
	set WinData($Window,yCoord) 0
	set WinData($Window,theta) $theta
	set WinData($Window,phi) $phi
	set WinData($Window,shading) $shading
	set WinData($Window,color) $color
	set WinData($Window,grid) $grid