Context Navigation

source: trunk/bkgedit @ 931

Last change on this file since 931 was 931, checked in by toby, 11 years ago
include rest of files
File size: 71.7 KB

Rev	Line
[931]	1	#!/bin/sh
	2	# the next line restarts this script using wish found in the path\
	3	exec wish "$0" "$@"
	4	# If this does not work, change the #!/usr/bin/wish line below
	5	# to reflect the actual wish location and delete all preceeding lines
	6	#
	7	# (delete here and above)
	8	#!/usr/bin/wish
	9	# $Id: liveplot,v 1.45 2008/04/15 17:25:56 toby Exp toby $
	10	set Revision {$Revision: 1.45 $ $Date: 2008/04/15 17:25:56 $}
	11
	12	package require Tk
	13	bind all <Control-KeyPress-c> {destroy .}
	14	# process command line arguments
	15	set exitstat 0
	16	set expnam [lindex $argv 0]
	17	if {$expnam == ""} {catch {puts "error -- no experiment name"}; set exitstat 1}
	18	if $exitstat {
	19	catch {puts "usage: $argv0 expnam \[hist #\] \[legend\]"}
	20	exit
	21	}
	22
	23	# get name of script
	24	set expgui(script) [info script]
	25	# what are we running here?
	26	set program [file tail $argv0]
	27	# fix up problem with starkit tcl
	28	if {$program != "liveplot" && $program != "bkgedit"} {
	29	set program [file tail $expgui(script)]
	30	}
	31	# for debug
	32	#set program bkgedit
	33
	34	if {[lindex $argv 1] == ""} {
	35	set hst 1
	36	} else {
	37	set hst [lindex $argv 1]
	38	}
	39	if {[lindex $argv 2] == ""} {
	40	set graph(legend) 1
	41	} else {
	42	set graph(legend) [lindex $argv 2]
	43	}
	44
	45	set graph(backsub) 0
	46
	47	if {$tcl_platform(platform) == "windows"} {
	48	set graph(printout) 1
	49	set expgui(tcldump) tcldump.exe
	50	} else {
	51	set graph(printout) 0
	52	set expgui(tcldump) tcldump
	53	}
	54
	55	# default values
	56	set cmprdir {}; # location for the cmpr package
	57	set weightlist {}
	58	set graph(outname) out.ps
	59	set graph(outcmd) lpr
	60	set xunits {}
	61	set yunits {}
	62	set graph(chi2) 0
	63	set graph(OmCoS) 0
	64	set graph(xunits) 0
	65	set graph(yunits) 0
	66	set graph(autoraise) 1
	67	set graph(color_diff) blue
	68	set graph(color_chi2) magenta
	69	set graph(color_OmCoS) magenta
	70	set graph(color_bkg) green
	71	set graph(color_obs) black
	72	set graph(color_input) magenta
	73	set graph(color_fit) blue
	74	set expgui(debug) 0
	75	catch {if $env(DEBUG) {set expgui(debug) 1}}
	76	#set expgui(debug) 1
	77	set expgui(font) 14
	78	set expgui(lblfontsize) 15
	79	set expgui(fadetime) 10
	80	set expgui(hklbox) 1
	81	set expgui(autotick) 0
	82	set expgui(pixelregion) 5
	83	# location for web pages, if not found locally
	84	set expgui(website) www.ncnr.nist.gov/xtal/software/expgui
	85	set peakinfo(obssym) scross
	86	if {$program == "bkgedit"} {
	87	set peakinfo(obssize) 0.15
	88	set graph(color_calc) pink
	89	} else {
	90	set peakinfo(obssize) 1.0
	91	set graph(color_calc) red
	92	}
	93	set peakinfo(inpsym) triangle
	94	set peakinfo(inpsize) 1.0
	95	# create a set of markers for each phase
	96	for {set i 1} {$i < 10} {incr i} {
	97	set peakinfo(flag$i) 0
	98	set peakinfo(max$i) Inf
	99	set peakinfo(min$i) -Inf
	100	set peakinfo(dashes$i) 1
	101	set graph(label$i) Phase$i
	102	}
	103	set expgui(RadiiList) {}
	104
	105	proc waitmsg {message} {
	106	set w .wait
	107	# kill any window/frame with this name
	108	catch {destroy $w}
	109	pack [frame $w]
	110	frame $w.bot -relief raised -bd 1
	111	pack $w.bot -side bottom -fill both
	112	frame $w.top -relief raised -bd 1
	113	pack $w.top -side top -fill both -expand 1
	114	label $w.msg -justify left -text $message -wrap 3i
	115	catch {$w.msg configure -font \
	116	-Adobe-Times-Medium-R-Normal---180------*
	117	}
	118	pack $w.msg -in $w.top -side right -expand 1 -fill both -padx 3m -pady 3m
	119	label $w.bitmap -bitmap info
	120	pack $w.bitmap -in $w.top -side left -padx 3m -pady 3m
	121	update
	122	}
	123
	124	proc donewaitmsg {} {
	125	catch {destroy .wait}
	126	update
	127	}
	128
	129	waitmsg "Loading histogram, Please wait"
	130
	131	#--------------------------------------------------------------
	132	# define constants
	133	array set peakinfo {
	134	color1 magenta
	135	color2 cyan
	136	color3 yellow
	137	color4 sienna
	138	color5 orange
	139	color6 DarkViolet
	140	color7 HotPink
	141	color8 salmon
	142	color9 LimeGreen
	143	}
	144	set cycle -1
	145	set modtime 0
	146
	147	#----------------------------------------------------------------
	148	# find location of other files relative to the current script
	149	# 1st, translate links -- go six levels deep
	150	foreach i {1 2 3 4 5 6} {
	151	if {[file type $expgui(script)] == "link"} {
	152	set link [file readlink $expgui(script)]
	153	if { [file pathtype $link] == "absolute" } {
	154	set expgui(script) $link
	155	} {
	156	set expgui(script) [file dirname $expgui(script)]/$link
	157	}
	158	} else {
	159	break
	160	}
	161	}
	162
	163	# fixup relative paths
	164	if {[file pathtype $expgui(script)] == "relative"} {
	165	set expgui(script) [file join [pwd] $expgui(script)]
	166	}
	167	set expgui(scriptdir) [file dirname $expgui(script) ]
	168	set expgui(gsasdir) [file dirname $expgui(scriptdir)]
	169	set expgui(gsasexe) [file join $expgui(gsasdir) exe]
	170	set expgui(docdir) [file join $expgui(scriptdir) doc]
	171
	172	source [file join $expgui(scriptdir) gsascmds.tcl]
	173	source [file join $expgui(scriptdir) readexp.tcl]
	174	source [file join $expgui(scriptdir) opts.tcl]
	175
	176	if {$program == "bkgedit"} {
	177	lappend auto_path $expgui(scriptdir)
	178	if {$tcl_version < 8.1} {
	179	MyMessageBox -parent . -title "La Load Error" \
	180	-message "$program requires Tcl/Tk version 8.1 or higher" \
	181	-helplink "expgui.html La" \
	182	-icon error -type Exit -default exit
	183	exit
	184	}
	185	if [catch {package require La} errmsg] {
	186	MyMessageBox -parent . -title "La Load Error" \
	187	-message "Error -- Unable to load the La (Linear Algebra) package; cannot run $program" \
	188	-helplink "expgui.html La" \
	189	-icon error -type Exit -default exit
	190	exit
	191	}
	192	}
	193
	194	if [catch {package require BLT} errmsg] {
	195	MyMessageBox -parent . -title "BLT Error" \
	196	-message "Error -- Unable to load the BLT package; cannot run $program" \
	197	-helplink "expgui.html blt" \
	198	-icon error -type Exit -default exit
	199	exit
	200	}
	201	# handle Tcl/Tk v8+ where BLT is in a namespace
	202	# use the command so that it is loaded
	203	catch {blt::graph}
	204	catch {
	205	namespace import blt::graph
	206	namespace import blt::vector
	207	}
	208	# old versions of blt don't report a version number
	209	if [catch {set blt_version}] {set blt_version 0}
	210	# option for coloring markers: note that GH keeps changing how to do this!
	211	# also element -mapped => -show
	212	if {$blt_version < 2.3 \|\| $blt_version >= 8.0} {
	213	# version 8.0 is ~same as 2.3
	214	set graph(MarkerColorOpt) -fg
	215	# mapped is needed in 8.0, both are OK in 2.3
	216	set graph(ElementShowOption) "-mapped 1"
	217	set graph(ElementHideOption) "-mapped 0"
	218	} elseif {$blt_version >= 2.4} {
	219	set graph(MarkerColorOpt) -outline
	220	set graph(ElementShowOption) "-hide 0"
	221	set graph(ElementHideOption) "-hide 1"
	222	} else {
	223	set graph(MarkerColorOpt) -color
	224	set graph(ElementShowOption) "-mapped 1"
	225	set graph(ElementHideOption) "-mapped 0"
	226	}
	227
	228	# called by a trace on expgui(lblfontsize)
	229	proc setfontsize {a b c} {
	230	global expgui graph
	231	catch {
	232	font config lblfont -size [expr -$expgui(lblfontsize)]
	233	# this forces a redraw of the plot by changing the title to itself
	234	.g configure -title [.g cget -title]
	235	}
	236	}
	237	# define a font used for labels
	238	if {$tcl_version >= 8.0} {
	239	font create lblfont -family Helvetica -size [expr -$expgui(lblfontsize)]
	240	trace variable expgui(lblfontsize) w setfontsize
	241	}
	242
	243	proc readdata {box} {
	244	global expgui modtime expnam
	245	if [catch {
	246	set modtime [file mtime $expnam.EXP]
	247	set loadtime [time {
	248	if {$expgui(tcldump) == ""} {
	249	set p HSTDMP
	250	readdata_hst $box
	251	} else {
	252	set p TCLDUMP
	253	readdata_tcl $box
	254	}
	255	}]
	256	if $expgui(debug) {
	257	tk_dialog .time "Timing info" \
	258	"Histogram loading took $loadtime" "" 0 OK
	259	}
	260	} errmsg] {
	261	if $expgui(debug) {
	262	catch {console show}
	263	error $errmsg
	264	}
	265	$box config -title "Read error"
	266	MyMessageBox -parent . -title "$p Error" \
	267	-message "There was an error running the $p program. The most common reason for this is that POWPREF & GENLES have not been run.\n\nError message: $errmsg" \
	268	-icon error -type Continue -default continue \
	269	-helplink "expguierr.html TCLDUMPError"
	270	update
	271	}
	272	$box element show [lsort -decreasing [$box element show]]
	273	global program
	274	if {$program == "bkgedit"} bkghstInit
	275	}
	276
	277	proc readdata_hst {box} {
	278	global expgui expnam reflns
	279	global lasthst
	280	global hst peakinfo xunits weightlist
	281	$box config -title "(Histogram update in progress)"
	282	update
	283	# parse the output of a file
	284	set lasthst $hst
	285	###########################################################################
	286	# set input [open histdump.inp w]
	287	# puts $input "$hst"
	288	# close $input
	289	# set input [open "\| $expgui(gsasexe)/hstdump $expnam < histdump.inp" w+]
	290	###########################################################################
	291	# use histdmp for histogram info
	292	set input [open histdump$hst.inp w]
	293	puts $input "$expnam"
	294	puts $input "L"
	295	puts $input "$hst"
	296	puts $input "0"
	297	close $input
	298	# use hstdmp without an experiment name so that output
	299	# is not sent to the .LST file
	300	set input [open "\| $expgui(gsasexe)/hstdmp < histdump$hst.inp" r]
	301
	302	# initalize arrays
	303	set num -1
	304	set xlist {}
	305	set obslist {}
	306	set calclist {}
	307	set bcklist {}
	308	set xunits {}
	309	set weightlist {}
	310	# define a list of reflection positions for each phase
	311	for {set i 1} {$i < 10} {incr i} {
	312	set reflns($i) {}
	313	}
	314	set i 0
	315	while {[gets $input line] >= 0} {
	316	incr i
	317	# run update every 50th line
	318	if {$i > 50} {set i 0; update}
	319	if [scan $line %d num] {
	320	if {$num > 0} {
	321	set Ispec 0
	322	set X -999
	323	scan [string range $line 8 end] %e%e%e%e%e%e \
	324	X Iobs Icalc Ispec fixB fitB
	325	#puts $line
	326	# eliminate excluded points
	327	if {$Ispec > 0.0 && $X >= 0} {
	328	lappend xlist $X
	329	lappend obslist $Iobs
	330	lappend calclist $Icalc
	331	lappend bcklist [expr {$fixB + $fitB}]
	332	}
	333	# add peaks to peak lists
	334	# puts "[string range $line 6 6]"
	335	# is this 6 or 7; 6 on win & 7 on SGI
	336	if [regexp {[1-9]} [string range $line 6 7] ph] {
	337	lappend reflns($ph) $X
	338	}
	339	}
	340	} else {
	341	regexp {Time\|Theta\|keV} $line xunits
	342	}
	343	}
	344	if {$xunits == "Theta"} {set xunits "2-Theta"}
	345	close $input
	346	catch {file delete histdump$hst.inp}
	347	xvec set $xlist
	348	obsvec set $obslist
	349	calcvec set $calclist
	350	bckvec set $bcklist
	351	diffvec set [obsvec - calcvec]
	352	foreach vec {obsvec calcvec diffvec} {
	353	# probably not needed with recent versions of BLT:
	354	global $vec
	355	# sometimes needed for latest version of BLT (2.4z)
	356	catch {$vec variable $vec}
	357	}
	358	set maxdiff [set diffvec(max)]
	359	set cmin [set calcvec(min)]
	360	set omin [set obsvec(min)]
	361	set cmax [set calcvec(max)]
	362	set omax [set obsvec(max)]
	363	set expgui(min) [expr {$omin < $cmin ? $omin : $cmin}]
	364	set expgui(max) [expr {$omax > $cmax ? $omax : $cmax}]
	365	set ymin1 [expr {$cmin - 1.1*$maxdiff}]
	366	set ymin2 [expr {$omin - 1.1*$maxdiff}]
	367	if {$ymin1 < $ymin2} {
	368	diffvec set [diffvec + $ymin1]
	369	} {
	370	diffvec set [diffvec + $ymin2]
	371	}
	372	plotdata
	373	}
	374
	375	proc readdata_tcl {box} {
	376	global expgui expnam reflns program
	377	global lasthst graph weightlist
	378	global hst peakinfo xunits yunits
	379	$box config -title "(Histogram update in progress)"
	380	update
	381	# parse the output of a file
	382	set lasthst $hst
	383	# use tcldump
	384	set input [open histdump$hst.inp w]
	385	puts $input "$hst"
	386	# x units -- native
	387	puts $input "$graph(xunits)"
	388	# y units -- native
	389	if {$program == "bkgedit"} {
	390	puts $input "1"
	391	} else {
	392	puts $input "$graph(yunits)"
	393	}
	394	# format (if implemented someday)
	395	puts $input "0"
	396	close $input
	397	# initalize arrays
	398	set X {}
	399	set OBS {}
	400	set CALC {}
	401	set BKG {}
	402	set WGT {}
	403	global refhkllist refphaselist refpos
	404	set refpos {}
	405	set refhkllist {}
	406	set refphaselist {}
	407	for {set i 1} {$i < 10} {incr i} {
	408	set reflns($i) {}
	409	}
	410	eval [exec $expgui(tcldump) $expnam < histdump$hst.inp]
	411	catch {file delete histdump$hst.inp}
	412	if {$X == ""} {
	413	$box config -title "(Error reading Histogram $hst)"
	414	foreach elem [$box element show] {
	415	eval $box element config $elem $graph(ElementHideOption)
	416	}
	417	return
	418	}
	419	foreach elem [$box element names] {
	420	eval $box element config $elem $graph(ElementShowOption)
	421	}
	422	xvec set $X
	423	obsvec set $OBS
	424	calcvec set $CALC
	425	bckvec set $BKG
	426	refposvec set $refpos
	427	diffvec set [obsvec - calcvec]
	428	set weightlist $WGT
	429	if {$graph(chi2)} {
	430	wifdvec set $WGT
	431	wifdvec set [wifdvec * diffvec]
	432	wifdvec set [wifdvec * diffvec]
	433	# now do a running sum
	434	set sum 0
	435	set sumlist {}
	436	foreach n [wifdvec range 0 end] {
	437	set sum [expr {$sum + $n}]
	438	lappend sumlist $sum
	439	}
	440	wifdvec set $sumlist
	441	wifdvec set [wifdvec / [wifdvec length]]
	442	}
	443	if {$graph(OmCoS)} {
	444	wifdvec set $WGT
	445	wifdvec expr sqrt(wifdvec)
	446	wifdvec set [wifdvec * diffvec]
	447	}
	448	if $graph(backsub) {
	449	obsvec set [obsvec - bckvec]
	450	calcvec set [calcvec - bckvec]
	451	}
	452	global obsvec calcvec diffvec
	453	set maxdiff [set diffvec(max)]
	454	set cmin [set calcvec(min)]
	455	set omin [set obsvec(min)]
	456	set cmax [set calcvec(max)]
	457	set omax [set obsvec(max)]
	458	set expgui(min) [expr {$omin < $cmin ? $omin : $cmin}]
	459	set expgui(max) [expr {$omax > $cmax ? $omax : $cmax}]
	460	set ymin1 [expr {$cmin - 1.1*$maxdiff}]
	461	set ymin2 [expr {$omin - 1.1*$maxdiff}]
	462	if {$ymin1 < $ymin2} {
	463	diffvec set [diffvec + $ymin1]
	464	} {
	465	diffvec set [diffvec + $ymin2]
	466	}
	467
	468	plotdata
	469	}
	470
	471	proc lblhkl {plot x} {
	472	global blt_version expgui tcl_platform tcl_version
	473	global refhkllist refphaselist peakinfo refpos
	474	# look for peaks within pixelregion pixels or the entire plot range
	475	if {$x == "all"} {
	476	foreach {xmin xmax} [$plot xaxis limits] {}
	477	} else {
	478	set xmin [$plot xaxis invtransform [expr {$x - $expgui(pixelregion)}]]
	479	set xmax [$plot xaxis invtransform [expr {$x + $expgui(pixelregion)}]]
	480	}
	481	set peaknums [refposvec search $xmin $xmax]
	482	set peaklist {}
	483	# create a box, if needed
	484	if {$expgui(hklbox)} {
	485	catch {
	486	toplevel .hkl
	487	text .hkl.txt -width 30 -height 10 -wrap none \
	488	-yscrollcommand ".hkl.yscroll set"
	489	scrollbar .hkl.yscroll -command ".hkl.txt yview"
	490	grid .hkl.txt -column 0 -row 1 -sticky nsew
	491	grid .hkl.yscroll -column 1 -row 1 -sticky ns
	492	grid columnconfigure .hkl 0 -weight 1
	493	grid rowconfigure .hkl 1 -weight 1
	494	wm title .hkl "Liveplot HKL Labels"
	495	wm iconname .hkl HKL
	496	.hkl.txt insert end "Phase\thkl\tPosition"
	497	}
	498	}
	499	set xcen 0
	500	set lbls 0
	501	foreach peak $peaknums {
	502	# put all hkls, all phases in the box
	503	if {$expgui(hklbox)} {
	504	catch {
	505	.hkl.txt insert end "\n[lindex $refphaselist $peak]"
	506	.hkl.txt insert end "\t[lindex $refhkllist $peak]"
	507	.hkl.txt insert end "\t[lindex $refpos $peak]"
	508	.hkl.txt see end
	509	}
	510	}
	511	# label phases with tick marks
	512	if [set peakinfo(flag[lindex $refphaselist $peak])] {
	513	set pos [refposvec range $peak $peak]
	514	if {$lbls <= 0} {
	515	set xcen $pos
	516	set peaklist [lindex $refhkllist $peak]
	517	set lbls 1
	518	} elseif {abs($xcen/$lbls-$pos) <= $expgui(pixelregion)} {
	519	set xcen [expr {$xcen + $pos}]
	520	lappend peaklist [lindex $refhkllist $peak]
	521	incr lbls
	522	} else {
	523	puthkllbl $plot $peaklist $xcen $lbls
	524	set xcen $pos
	525	set peaklist [lindex $refhkllist $peak]
	526	set lbls 1
	527	}
	528	}
	529	}
	530	puthkllbl $plot $peaklist $xcen $lbls
	531	}
	532
	533	proc puthkllbl {plot peaklist xcen lbls} {
	534	global blt_version tcl_platform tcl_version expgui
	535	if {$peaklist == ""} return
	536	set xcen [expr {$xcen / $lbls}]
	537	# avoid bug in BLT 2.3 where Inf does not work for text markers
	538	if {$blt_version == 2.3} {
	539	set ycen [lindex [$plot yaxis limits] 1]
	540	} else {
	541	set ycen Inf
	542	}
	543	# older BLT versions can't rotate text in windows
	544	if {$tcl_platform(platform) == "windows" && \
	545	($blt_version <= 2.3 \|\| $blt_version == 8.0)} {
	546	regsub -all { } $peaklist "\n" peaklist
	547	set mark [$plot marker create text -coords "$xcen $ycen" \
	548	-text $peaklist -anchor n -bg "" -name hkl$xcen]
	549	} else {
	550	set mark [$plot marker create text -coords "$xcen $ycen" \
	551	-rotate 90 -text $peaklist -anchor n -bg "" -name hkl$xcen]
	552	}
	553	if {$tcl_version >= 8.0} {
	554	$plot marker config hkl$xcen -font lblfont
	555	}
	556	if {$expgui(fadetime) > 0} {
	557	catch {
	558	after [expr {$expgui(fadetime) * 1000 }] \
	559	"catch \{ $plot marker delete $mark \}"
	560	}
	561	}
	562	}
	563
	564	proc delallhkllbl {plot} {
	565	catch {
	566	eval $plot marker delete [$plot marker names hkl*]
	567	}
	568	}
	569
	570	proc plotdata {} {
	571	global expnam hst peakinfo xunits yunits cycle reflns modtime
	572	global lasthst graph expgui box
	573
	574	# is there a new histogram to load?
	575	if {$hst != $lasthst} {
	576	xvec set {}
	577	xvec notify now
	578	set cycle -1
	579	set modtime 0
	580	$box config -title "Please wait: loading histogram $hst"
	581	update
	582	return
	583	}
	584	$box config -title "$expnam cycle $cycle Hist $hst"
	585	$box xaxis config -title $xunits
	586	$box yaxis config -title $yunits
	587	setlegend $box $graph(legend)
	588	# reconfigure the data
	589	catch {$box element configure 3 -symbol $peakinfo(obssym)}
	590	catch {$box element configure 3 -color $graph(color_obs)}
	591	catch {$box element configure 3 -pixels [expr 0.125 * $peakinfo(obssize)]i}
	592	if $graph(chi2) {
	593	$box element config 0 -dash 0 -line 3
	594	catch {$box element config 0 -color $graph(color_chi2)}
	595	} else {
	596	$box element config 0 -dash 4 -line 2
	597	catch {$box element config 0 -color $graph(color_OmCoS)}
	598	}
	599	catch {$box element config 1 -color $graph(color_bkg)}
	600	catch {$box element config 2 -color $graph(color_calc)}
	601	catch {$box element config 4 -color $graph(color_diff)}
	602	global program
	603	if {$program == "bkgedit"} {
	604	catch {$box element config 12 -color $graph(color_input)}
	605	catch {$box element config 12
	606	-pixels [expr 0.125 * $peakinfo(inpsize)]i}
	607	catch {$box element config 12 -symbol $peakinfo(inpsym)}
	608	catch {$box element config 11 -color $graph(color_fit)}
	609	}
	610	xvec notify now
	611	obsvec notify now
	612	calcvec notify now
	613	bckvec notify now
	614	diffvec notify now
	615	wifdvec notify now
	616	# now deal with peaks
	617	for {set i 1} {$i < 10} {incr i} {
	618	if {$expgui(autotick)} {
	619	set div [expr {( $expgui(max) - $expgui(min) )/40.}]
	620	set ymin [expr {$expgui(min) - ($i+1) * $div}]
	621	set ymax [expr {$expgui(min) - $i * $div}]
	622	} else {
	623	set ymin $peakinfo(min$i)
	624	set ymax $peakinfo(max$i)
	625	}
	626	set j 0
	627	if [set peakinfo(flag$i)] {
	628	foreach X $reflns($i) {
	629	incr j
	630	catch {
	631	$box marker create line -name peaks${i}_$j
	632	}
	633	$box marker config peaks${i}_$j -under 1 \
	634	-coords "$X $ymin $X $ymax"
	635	catch {
	636	$box marker config peaks${i}_$j \
	637	$graph(MarkerColorOpt) [list $peakinfo(color$i)]
	638	if $peakinfo(dashes$i) {
	639	$box marker config peaks${i}_$j -dashes "5 5"
	640	}
	641	}
	642	}
	643	catch {$box element create phase$i}
	644	catch {
	645	$box element config phase$i -color $peakinfo(color$i) \
	646	-label $graph(label$i)
	647	}
	648	} else {
	649	eval $box marker delete [$box marker names peaks${i}_*]
	650	eval $box element delete [$box element names phase$i]
	651	}
	652	}
	653	# force an update of the plot as BLT may not
	654	$box config -title [$box cget -title]
	655	update
	656	}
	657
	658	proc setlegend {box legend} {
	659	global blt_version
	660	if {$blt_version >= 2.3 && $blt_version < 8.0} {
	661	if $legend {
	662	$box legend config -hide no
	663	} else {
	664	$box legend config -hide yes
	665	}
	666	} else {
	667	if $legend {
	668	$box legend config -mapped yes
	669	} else {
	670	$box legend config -mapped no
	671	}
	672	}
	673	}
	674
	675	proc minioptionsbox {num} {
	676	global blt_version tcl_platform peakinfo expgui
	677	set bx .opt$num
	678	catch {destroy $bx}
	679	toplevel $bx
	680	wm iconname $bx "Phase $num options"
	681	wm title $bx "Phase $num options"
	682
	683	set i $num
	684	pack [label $bx.0 -text "Phase $i reflns" ] -side top
	685	pack [checkbutton $bx.1 -text "Show reflections" \
	686	-variable peakinfo(flag$i)] -side top
	687	# remove option that does not work
	688	if {$blt_version != 8.0 \|\| $tcl_platform(platform) != "windows"} {
	689	pack [checkbutton $bx.2 -text "Use dashed line" \
	690	-variable peakinfo(dashes$i)] -side top
	691	}
	692	if !$expgui(autotick) {
	693	pack [frame $bx.p$i -bd 2 -relief groove] -side top
	694	# pack [checkbutton $bx.p$i.0 -text "Show phase $i reflns" \
	695	# -variable peakinfo(flag$i)] -side left -anchor w
	696	pack [label $bx.p$i.1 -text " Y min:"] -side left
	697	pack [entry $bx.p$i.2 -textvariable peakinfo(min$i) -width 5] \
	698	-side left
	699	pack [label $bx.p$i.3 -text " Y max:"] -side left
	700	pack [entry $bx.p$i.4 -textvariable peakinfo(max$i) -width 5] \
	701	-side left
	702	}
	703	pack [frame $bx.c$i -bd 2 -relief groove] -side top
	704
	705	pack [label $bx.c$i.5 -text " color:"] -side left
	706	pack [entry $bx.c$i.6 -textvariable peakinfo(color$i) -width 12] \
	707	-side left
	708	pack [button $bx.c$i.2 -bg $peakinfo(color$i) -state disabled] -side left
	709	pack [button $bx.c$i.1 -text "Color\nmenu" \
	710	-command "setcolor $i"] -side left
	711
	712	pack [frame $bx.l$i -bd 2 -relief groove] -side top
	713
	714	pack [label $bx.l$i.1 -text " Phase label:"] -side left
	715
	716	pack [entry $bx.l$i.2 -textvariable graph(label$i) -width 20] \
	717	-side left
	718
	719	pack [frame $bx.b] -side top
	720	pack [button $bx.b.4 -command "destroy $bx; plotdata" \
	721	-text Close ] -side right
	722	}
	723
	724	proc setcolor {num} {
	725	global peakinfo
	726	set color [tk_chooseColor -initialcolor $peakinfo(color$num) -title "Choose color"]
	727	if {$color == ""} return
	728	set peakinfo(color$num) $color
	729	}
	730
	731	proc setSymcolor {var lbl} {
	732	global graph
	733	set color [tk_chooseColor -initialcolor $graph(color_$var) \
	734	-title "Choose $lbl color"]
	735	if {$color == ""} return
	736	set graph(color_$var) $color
	737	}
	738
	739	proc makepostscriptout {} {
	740	global graph box
	741	if !$graph(printout) {
	742	set out [open "\| $graph(outcmd) >& liveplot.msg" w]
	743	catch {
	744	puts $out [$box postscript output -landscape 1 \
	745	-decorations no -height 7.i -width 9.5i]
	746	close $out
	747	} msg
	748	catch {
	749	set out [open liveplot.msg r]
	750	if {$msg != ""} {append msg "\n"}
	751	append msg [read $out]
	752	close $out
	753	catch {file delete liveplot.msg}
	754	}
	755	if {$msg != ""} {
	756	tk_dialog .msg "file created" \
	757	"Postscript file processed with command \
	758	$graph(outcmd). Result: $msg" "" 0 OK
	759	} else {
	760	tk_dialog .msg "file created" \
	761	"Postscript file processed with command \
	762	$graph(outcmd)" "" 0 OK
	763	}
	764	} else {
	765	$box postscript output $graph(outname) -landscape 1 \
	766	-decorations no -height 7.i -width 9.5i
	767	tk_dialog .msg "file created" \
	768	"Postscript file $graph(outname) created" "" 0 OK
	769	}
	770	}
	771
	772	proc setprintopt {page} {
	773	global graph
	774	if $graph(printout) {
	775	$page.4.1 config -fg black
	776	$page.4.2 config -fg black -state normal
	777	$page.6.1 config -fg #888
	778	$page.6.2 config -fg #888 -state disabled
	779	} else {
	780	$page.4.1 config -fg #888
	781	$page.4.2 config -fg #888 -state disabled
	782	$page.6.1 config -fg black
	783	$page.6.2 config -fg black -state normal
	784	}
	785	}
	786
	787	proc setpostscriptout {} {
	788	global graph tcl_platform
	789	set box .out
	790	catch {destroy $box}
	791	toplevel $box
	792	focus $box
	793	wm title $box "Set PS options"
	794	pack [frame $box.4] -side top -anchor w -fill x
	795	pack [checkbutton $box.4.a -text "Write PostScript files" \
	796	-variable graph(printout) -offvalue 0 -onvalue 1 \
	797	-command "setprintopt $box"] -side left -anchor w
	798	pack [entry $box.4.2 -textvariable graph(outname)] -side right -anchor w
	799	pack [label $box.4.1 -text "PostScript file name:"] -side right -anchor w
	800	pack [frame $box.6] -side top -anchor w -fill x
	801	pack [checkbutton $box.6.a -text "Print PostScript files" \
	802	-variable graph(printout) -offvalue 1 -onvalue 0 \
	803	-command "setprintopt $box" ] -side left -anchor w
	804	pack [entry $box.6.2 -textvariable graph(outcmd)] -side right -anchor w
	805	pack [label $box.6.1 -text "Command to print files:"] -side right -anchor w
	806
	807	pack [button $box.a -text "Close" -command "destroy $box"] -side top
	808	if {$tcl_platform(platform) == "windows"} {
	809	set graph(printout) 1
	810	$box.4.a config -state disabled
	811	$box.6.a config -fg #888 -state disabled
	812	}
	813	setprintopt $box
	814	}
	815
	816	#-------------------------------------------------------------------------
	817	# export current plot to Grace
	818	#-------------------------------------------------------------------------
	819	if {$tcl_platform(platform) == "unix"} {
	820	set graph(GraceFile) /tmp/grace_out.agr
	821	} else {
	822	set graph(GraceFile) C:/graceout.agr
	823	}
	824	proc exportgrace {} {
	825	global graph box
	826	global tcl_platform graph
	827	catch {toplevel .export}
	828	raise .export
	829	eval destroy [grid slaves .export]
	830	set col 5
	831	grid [label .export.1a -text Title:] -column 1 -row 1
	832	set graph(title) [$box cget -title]
	833	grid [entry .export.1b -width 60 -textvariable graph(title)] \
	834	-column 2 -row 1 -columnspan 4
	835	grid [label .export.2a -text Subtitle:] -column 1 -row 2
	836	grid [entry .export.2b -width 60 -textvariable graph(subtitle)] \
	837	-column 2 -row 2 -columnspan 4
	838	grid [label .export.3a -text "File name:"] -column 1 -row 3
	839	grid [entry .export.3b -width 60 -textvariable graph(GraceFile)] \
	840	-column 2 -row 3 -columnspan 4
	841	grid [button .export.help -text Help -bg yellow \
	842	-command "MakeWWWHelp liveplot.html grace"] \
	843	-column [incr col -1] -row 4
	844	grid [button .export.c -text "Close" \
	845	-command "set graph(export) 0; destroy .export"] \
	846	-column [incr col -1] -row 4
	847	if {$tcl_platform(platform) == "unix" && [auto_execok xmgrace] != ""} {
	848	grid [button .export.d -text "Export & \nstart grace" \
	849	-command "set graph(export) 1; destroy .export"] \
	850	-column [incr col -1] -row 4
	851	}
	852	grid [button .export.e -text "Export" \
	853	-command "set graph(export) 2; destroy .export"] \
	854	-column [incr col -1] -row 4
	855	tkwait window .export
	856	if {$graph(export) == 0} return
	857	if {[catch {
	858	set fp [open $graph(GraceFile) w]
	859	puts $fp [output_grace $box $graph(title) $graph(subtitle)]
	860	close $fp
	861	} errmsg]} {
	862	MyMessageBox -parent . -title "Export Error" \
	863	-message "An error occured during the export: $errmsg" \
	864	-icon error -type Ignore -default ignore
	865	return
	866	}
	867
	868	if {$graph(export) == 1} {
	869	set err [catch {exec xmgrace $graph(GraceFile) &} errmsg]
	870	if $err {
	871	MyMessageBox -parent . -title "Grace Error" \
	872	-message "An error occured launching grace (xmgrace): $errmsg" \
	873	-icon error -type Ignore -default ignore
	874	}
	875	} else {
	876	MyMessageBox -parent . -title "OK" \
	877	-message "File $graph(GraceFile) created" \
	878	-type OK -default ok
	879	}
	880	}
	881	#-------------------------------------------------------------------------
	882	# export current plot as .csv file
	883	#-------------------------------------------------------------------------
	884	proc makecsvfile {} {
	885	global graph box expnam hst
	886	global tcl_platform graph
	887	set typelist {
	888	{{Comma separated} {.csv} }
	889	{{Text File} {.txt} }
	890	}
	891	set file [tk_getSaveFile -filetypes $typelist \
	892	-initialfile ${expnam}_$hst.csv]
	893	if {$file == ""} return
	894	foreach vec {xvec obsvec calcvec bckvec diffvec wifdvec} \
	895	var {X O C B D CC } {
	896	set $var {}
	897	catch {set $var [$vec range 0 end]}
	898	}
	899	set fp [open $file w]
	900	# get x and y axis limits
	901	foreach v {x y} {
	902	foreach "${v}min ${v}max" [$graph(blt) ${v}axis limits] {}
	903	puts $fp "\"$v axis range [set ${v}min] to [set ${v}max]\""
	904	global ${v}units
	905	puts $fp "\"$v axis label [set ${v}units]\""
	906	}
	907	puts $fp {"Columns are X I(obs) I(calc) I(bkg) Obs-Calc cum-chi**2 refpos ref-phase ref-hkl"}
	908	global refhkllist refphaselist refpos
	909	foreach x $X o $O c $C b $B d $D cc $CC \
	910	hkl $refhkllist rphase $refphaselist rp $refpos {
	911	# replace commas with spaces
	912	regsub -all "," $hkl " " hkl
	913	puts $fp ", $x, $o, $c, $b, $d, $cc, $rp, $rphase, [list $hkl],"
	914	}
	915	close $fp
	916	}
	917
	918	proc setlblopts {} {
	919	global expgui tcl_platform tcl_version
	920	set box .out
	921	catch {destroy $box}
	922	toplevel $box
	923	focus $box
	924	wm title $box "Set hkl options"
	925	pack [frame $box.c] -side top -anchor w
	926	pack [label $box.c.l -text "HKL label\nerase time:"] -side left
	927	pack [entry $box.c.e -textvariable expgui(fadetime) -width 8] \
	928	-side left
	929	pack [label $box.c.l1 -text seconds] -side left
	930	pack [frame $box.d] -side top -anchor w
	931	pack [label $box.d.l -text "HKL label size:"] -side left
	932	pack [entry $box.d.e -textvariable expgui(lblfontsize) -width 4] \
	933	-side left
	934	pack [label $box.d.l1 -text pixels] -side left
	935	# old versions if tcl/tk don't support the font command
	936	if {$tcl_version < 8.0} {
	937	$box.d.l config -fg #888
	938	$box.d.e config -fg #888 -state disabled
	939	$box.d.l1 config -fg #888
	940	}
	941	pack [frame $box.f] -side top -anchor w
	942	pack [label $box.f.l -text "HKL search region:"] -side left
	943	pack [entry $box.f.e -textvariable expgui(pixelregion) -width 3] \
	944	-side left
	945	pack [label $box.f.l1 -text pixels] -side left
	946	pack [frame $box.e] -side top -anchor w
	947	pack [checkbutton $box.e.b -text "Separate window for HKL labels"\
	948	-variable expgui(hklbox)] -side left
	949	pack [button $box.a -text "Close" -command "destroy $box"] -side top
	950	}
	951
	952	proc getsymopts {"sym obs"} {
	953	global expgui peakinfo
	954	set box .out
	955	catch {destroy $box}
	956	toplevel $box
	957	focus $box
	958	wm title .out "set $sym symbol"
	959	pack [frame $box.d] -side left -anchor n
	960	pack [label $box.d.t -text "Symbol type"] -side top
	961	set expgui(sym) $peakinfo(${sym}sym)
	962	set expgui(size) $peakinfo(${sym}size)
	963	foreach symbol {square circle diamond triangle plus cross \
	964	splus scross} \
	965	symbol_name {square circle diamond triangle plus cross \
	966	thin-plus thin-cross} {
	967	pack [radiobutton $box.d.$symbol \
	968	-text $symbol_name -variable expgui(sym) \
	969	-value $symbol] -side top -anchor w
	970	}
	971	pack [frame $box.e] -side left -anchor n -fill y
	972	pack [label $box.e.l -text "Symbol Size"] -side top
	973	pack [scale $box.e.s -variable expgui(size) \
	974	-from .1 -to 3 -resolution 0.05] -side top
	975	pack [frame $box.a] -side bottom
	976	pack [button $box.a.1 -text "Apply" -command "setsymopts $sym"] -side left
	977	pack [button $box.a.2 -text "Close" -command "destroy $box"] -side left
	978	}
	979	proc setsymopts {sym} {
	980	global peakinfo expgui
	981	if {$peakinfo(${sym}sym) != $expgui(sym)} {set peakinfo(${sym}sym) $expgui(sym)}
	982	if {$peakinfo(${sym}size) != $expgui(size)} {set peakinfo(${sym}size) $expgui(size)}
	983	}
	984
	985	# save some of the global options in ~/.gsas_config
	986	proc SaveOptions {} {
	987	global graph expgui peakinfo tcl_platform
	988	if {$tcl_platform(platform) == "windows"} {
	989	set fp [open c:/gsas.config a]
	990	} else {
	991	set fp [open [file join ~ .gsas_config] a]
	992	}
	993	puts $fp "# LIVEPLOT saved options from [clock format [clock seconds]]"
	994	foreach v {printout legend outname outcmd autoraise chi2 xunits yunits OmCoS} {
	995	puts $fp "set graph($v) [list $graph($v)]"
	996	}
	997	foreach v {diff chi2 bkg calc obs input fit OmCoS} {
	998	puts $fp "set graph(color_$v) [list $graph(color_$v)]"
	999	}
	1000	foreach v {font lblfontsize fadetime hklbox pixelregion autotick} {
	1001	puts $fp "set expgui($v) [list $expgui($v)]"
	1002	}
	1003	foreach v {obssym obssize inpsym inpsize} {
	1004	puts $fp "set peakinfo($v) [list $peakinfo($v)]"
	1005	}
	1006	close $fp
	1007	}
	1008
	1009	proc aboutliveplot {} {
	1010	global Revision
	1011	tk_dialog .warn About "
	1012	GSAS\n\
	1013	A. C. Larson and\n R. B. Von Dreele,\n LANSCE, Los Alamos\n\n\
	1014	LIVEPLOT\nB. Toby, NIST\nNot subject to copyright\n\n\
	1015	$Revision\n\
	1016	" {} 0 OK
	1017	}
	1018
	1019	proc getcycle {} {
	1020	global expnam
	1021	set cycle -1
	1022	catch {
	1023	set fp [open $expnam.EXP r]
	1024	set text [read $fp]
	1025	close $fp
	1026	regexp {GNLS RUN.Total cycles run ([0-9]*) } $text x cycle
	1027	}
	1028	return $cycle
	1029	}
	1030
	1031	proc updateifnew {} {
	1032	global cycle modtime expnam env tcl_platform graph
	1033	# has the .EXP file been changed?
	1034	set newmodtime $modtime
	1035	catch {set newmodtime [file mtime $expnam.EXP]}
	1036	if {$newmodtime != $modtime} {
	1037	# are we in windows and are "locked?" If not, OK to update
	1038	if {$tcl_platform(platform) == "windows" && [file exists expgui.lck]} {
	1039	.g config -title "(Experiment directory locked)"
	1040	} else {
	1041	set modtime [file mtime $expnam.EXP]
	1042	set newcycle [getcycle]
	1043	if {$newcycle != $cycle} {
	1044	set cycle $newcycle
	1045	readdata .g
	1046	}
	1047	if {$tcl_platform(platform) == "windows" && $graph(autoraise)} {
	1048	# raise does not seem to be global in Windows,
	1049	# but this works in Win-95
	1050	# nothing seems to work in Win-NT
	1051	wm withdraw .
	1052	wm deiconify .
	1053	} elseif {$graph(autoraise)} {
	1054	raise .
	1055	}
	1056	}
	1057	}
	1058	# check again in a second
	1059	after 1000 updateifnew
	1060	}
	1061
	1062	proc plotdataupdate {array element action} {
	1063	global box peakinfo reflns graph
	1064	# parse the element
	1065	regexp {([a-z])([0-9])} $element junk var num
	1066	if {$var == "color"} {
	1067	if {$peakinfo($element) == ""} return
	1068	if [catch {
	1069	.opt$num.c$num.2 config -bg $peakinfo($element)
	1070	} ] return
	1071	set i $num
	1072	set j 0
	1073	if [set peakinfo(flag$i)] {
	1074	catch {
	1075	$box element config phase$i -color $peakinfo(color$i)
	1076	}
	1077	foreach X $reflns($i) {
	1078	incr j
	1079	catch {
	1080	$box marker config peaks${i}_$j \
	1081	$graph(MarkerColorOpt) [list $peakinfo(color$i)]
	1082	}
	1083	}
	1084	}
	1085	return
	1086	}
	1087	waitmsg {Updating}
	1088	plotdata
	1089	donewaitmsg
	1090	}
	1091	proc ShowCumulativeChi2 {} {
	1092	global graph box
	1093	if $graph(chi2) {
	1094	catch {$box y2axis config -min 0}
	1095	$box y2axis config -title {Cumulative Chi Squared}
	1096	eval $box y2axis config $graph(ElementShowOption)
	1097	eval $box element config 0 $graph(ElementShowOption) -label "Chi2"
	1098	#$box elem conf 0 -dash 0 -line 3
	1099	set cycle [getcycle]
	1100	readdata .g
	1101	} elseif $graph(OmCoS) {
	1102	catch {$box y2axis config -min ""}
	1103	$box y2axis config -title {(obs-calc)/sigma}
	1104	eval $box y2axis config $graph(ElementShowOption)
	1105	eval $box element config 0 $graph(ElementShowOption) -label "(O-C)/s"
	1106	#$box elem conf 0 -dash 4 -line 2
	1107	set cycle [getcycle]
	1108	readdata .g
	1109	} else {
	1110	eval $box element config 0 $graph(ElementHideOption)
	1111	eval $box y2axis config $graph(ElementHideOption)
	1112	$box element config 0 -label ""
	1113	}
	1114	}
	1115
	1116	# evaluate the Chebyshev polynomial with coefficients A at point x
	1117	# coordinates are rescaled from $xmin=-1 to $xmax=1
	1118	proc chebeval {A x xmin xmax} {
	1119	set xs [expr {-1 + 2 * (1.$x - $xmin) / (1.$xmax - 1.*$xmin)}]
	1120	set Tpp 0
	1121	set Tp 0
	1122	set total 0
	1123	foreach a $A {
	1124	if {$Tpp == $Tp && $Tp == 0} {
	1125	set T 1
	1126	} elseif {$Tpp == 0} {
	1127	set T $xs
	1128	} else {
	1129	set T [expr {2. * $xs * $Tp - $Tpp}]
	1130	}
	1131	set total [expr {$total + $a * $T}]
	1132	set Tpp $Tp
	1133	set Tp $T
	1134	}
	1135	return $total
	1136	}
	1137
	1138	# change the binding of the mouse, based on the selected mode
	1139	proc bkgEditMode {b} {
	1140	global zoomcommand graph box
	1141	# save the zoom command
	1142	if [catch {set zoomcommand}] {
	1143	set zoomcommand [bind $graph(bindtag) <1>]
	1144	.bkg.f.fit1 config -state disabled
	1145	.bkg.f.terms config -state disabled
	1146	}
	1147	if {$b == ""} {
	1148	foreach c {1 2 3} {
	1149	if {[.bkg.l.b$c cget -relief] == "sunken"} {set b $c}
	1150	}
	1151	}
	1152	foreach c {1 2 3} {
	1153	if {$c == $b} {
	1154	.bkg.l.b$c config -relief sunken
	1155	} else {
	1156	.bkg.l.b$c config -relief raised
	1157	}
	1158	}
	1159	# reset previous mode; if in the middle
	1160	if {[string trim [bind $box <Motion>]] != ""} {
	1161	blt::ResetZoom $box
	1162	}
	1163	if {$b == 2} {
	1164	bind $graph(bindtag) <1> "bkgAddPoint %x %y"
	1165	.g config -cursor arrow
	1166	} elseif {$b == 3} {
	1167	bind $graph(bindtag) <1> "bkgDelPoint %x %y"
	1168	.g config -cursor circle
	1169	} else {
	1170	bind $graph(bindtag) <1> $zoomcommand
	1171	.g config -cursor crosshair
	1172	}
	1173	}
	1174
	1175	# plot the background points
	1176	proc bkgPointPlot {} {
	1177	global bkglist termmenu expgui expnam hst tmin tmax
	1178	set l {}
	1179	set fp [open $expnam.bkg$hst w]
	1180	puts $fp "y p h e $hst b ! fixed background points for use in BKGEDIT"
	1181	foreach p $bkglist {
	1182	puts $fp "i\t$p\t0.0"
	1183	append l " $p"
	1184	}
	1185	if {[llength $bkglist] > 0} {
	1186	puts $fp "i\t[expr $tmin*0.99] [lindex [lindex $bkglist 0] 1]\t0.0"
	1187	puts $fp "i\t[expr $tmax*1.01] [lindex [lindex $bkglist end] 1]\t0.0"
	1188	}
	1189	close $fp
	1190	.g element config 12 -data $l
	1191	if {[set l [llength $bkglist]] > 3} {
	1192	.bkg.f.fit1 config -state normal
	1193	.bkg.f.terms config -state normal
	1194	$termmenu delete 0 end
	1195	set imax {}
	1196	set termmax [expr {$l/1.5}]
	1197	if {$termmax > 36} {set termmax 36}
	1198	for {set i 2} {$i <= $termmax} {incr i 2} {
	1199	$termmenu insert end radiobutton -label $i \
	1200	-variable expgui(FitOrder) -command "BkgFillTermBoxes nosave"
	1201	set imax $i
	1202	}
	1203	if {$imax < $expgui(FitOrder)} {set expgui(FitOrder) $imax}
	1204	} else {
	1205	.bkg.f.fit1 config -state disabled
	1206	.bkg.f.terms config -state disabled
	1207	set expgui(FitOrder) 2
	1208	}
	1209	}
	1210
	1211	# add a bkg point at screen coordinates x,y
	1212	proc bkgAddPoint {x y} {
	1213	global bkglist tmin tmax
	1214	set xy [.g invtransform $x $y]
	1215	set x [lindex $xy 0]
	1216	if {$x < $tmin} {set x $tmin}
	1217	if {$x > $tmax} {set x $tmax}
	1218	lappend bkglist [list $x [lindex $xy 1]]
	1219	set bkglist [lsort -real -index 0 $bkglist]
	1220	bkgFillPoints
	1221	bkgPointPlot
	1222	}
	1223
	1224	# delete the bkg point closest to screen coordinates x,y
	1225	proc bkgDelPoint {x y} {
	1226	global bkglist
	1227	set closest {}
	1228	set dist2 {}
	1229	set i -1
	1230	foreach p $bkglist {
	1231	incr i
	1232	set sxy [eval .g transform $p]
	1233	if {$closest == ""} {
	1234	set closest $i
	1235	set dist2 0
	1236	foreach v1 $sxy v2 "$x $y" {
	1237	set dist2 [expr {$dist2 + ($v1 - $v2)*($v1 - $v2)}]
	1238	}
	1239	} else {
	1240	set d2 0
	1241	foreach v1 $sxy v2 "$x $y" {
	1242	set d2 [expr {$d2 + ($v1 - $v2)*($v1 - $v2)}]
	1243	}
	1244	if {$d2 < $dist2} {
	1245	set closest $i
	1246	set dist2 $d2
	1247	}
	1248	}
	1249	}
	1250	set bkglist [lreplace $bkglist $closest $closest]
	1251	bkgPointPlot
	1252	bkgFillPoints
	1253	}
	1254
	1255	# initialize the background plot
	1256	proc bkghstInit {} {
	1257	global bkglist tmin tmax hst expnam termlist expgui
	1258	set tmin [histinfo $hst tmin]
	1259	set tmax [histinfo $hst tmax]
	1260	if {[catch {expr $tmin}] \|\| [catch {expr $tmax}]} {
	1261	tk_dialog .err "MIN/MAX Error" "Error -- Unable read tmin or tmax (has POWPREF been run?" \
	1262	error 0 Quit
	1263	destroy .
	1264	}
	1265
	1266	set bkglist {}
	1267	if [file exists $expnam.bkg$hst] {
	1268	catch {
	1269	set fp [open $expnam.bkg$hst r]
	1270	gets $fp line
	1271	while {[gets $fp line]>=0} {
	1272	set x [lindex $line 1]
	1273	set y [lindex $line 2]
	1274	if {$x >= $tmin && $x <= $tmax} {
	1275	lappend bkglist [list $x $y]
	1276	}
	1277	}
	1278	}
	1279	close $fp
	1280	}
	1281
	1282	bkgEditMode 1
	1283	bkgPointPlot
	1284	bkgFillPoints
	1285	set termlist ""
	1286	set expgui(FitOrder) 2
	1287	BkgFillTermBoxes nosave
	1288	}
	1289
	1290	proc bkgFit {button} {
	1291	global bkglist termlist expgui
	1292	# if there <3 points, a fit is not possible
	1293	if {[llength $bkglist] < 3} {
	1294	bell
	1295	return
	1296	}
	1297	# keep the button down while working
	1298	$button config -relief sunken
	1299	update
	1300	# make a list of X & Y values
	1301	foreach p $bkglist {
	1302	lappend S 1.
	1303	foreach v $p var {X Y} {
	1304	lappend $var $v
	1305	}
	1306	}
	1307
	1308	# perform the Fit
	1309	set termlist [FitBkgFunc $X $Y $expgui(FitOrder) $expgui(FitFunction) \
	1310	$expgui(RadiiList)]
	1311	# set the bkg terms in the edit boxes & update the plot
	1312	BkgFillTermBoxes
	1313	$button config -relief raised
	1314	}
	1315
	1316	# put the Background coefficients into edit widgets
	1317	proc BkgFillTermBoxes {"save {}"} {
	1318	global termlist expgui
	1319	global bkgeditbox
	1320	catch {destroy .bkg.canvas.fr}
	1321	set top [frame .bkg.canvas.fr]
	1322	.bkg.canvas create window 0 0 -anchor nw -window $top
	1323	# delete trace on bkgeditbox
	1324	foreach v [ trace vinfo bkgeditbox] {
	1325	eval trace vdelete bkgeditbox $v
	1326	}
	1327
	1328	.bkg.cw config -state normal
	1329	set k 0
	1330	# if {$expgui(FitFunction) == 3} {
	1331	# # o is number of refinable terms
	1332	# set o [expr {2 + ($expgui(FitOrder) - 2)/2}]
	1333	# grid [label $top.lbl -text terms] -column $k -row 1
	1334	# if {$expgui(FitOrder) >= 4} {
	1335	# grid [label $top.rlbl -text radii] -column $k -row 2
	1336	# }
	1337	# incr k
	1338	# set width 7
	1339	# } else {
	1340	set o $expgui(FitOrder)
	1341	set width 10
	1342	# }
	1343	for {set i 0} {$i < $o} {incr i} {
	1344	if {$i >= [llength $termlist]} {lappend termlist 0.}
	1345	set bkgeditbox($i) [lindex $termlist $i]
	1346	grid [frame $top.$i -relief groove -bd 3] -column $k -row 1
	1347	grid [label $top.$i.l -text "[expr 1+$i]"] -column 1 -row 1
	1348	grid [entry $top.$i.e -textvariable bkgeditbox($i) -width $width] \
	1349	-column 2 -row 1
	1350	# if {$expgui(FitFunction) == 3 && $i > 1} {
	1351	# set j [expr $i-2]
	1352	# if {$j >= [llength $expgui(RadiiList)]} {lappend expgui(RadiiList) 0.}
	1353	# set bkgeditbox(r$j) [lindex $expgui(RadiiList) $j]
	1354	# if {$bkgeditbox(r$j) == 0} {
	1355	# set bkgeditbox(r$j) ??
	1356	# }
	1357	# grid [frame $top.r$j -relief groove -bd 3] \
	1358	# -column [expr $k-2] -row 2
	1359	# grid [label $top.r$j.l -text "[expr -1+$i]"] -column 1 -row 1
	1360	# grid [entry $top.r$j.e -textvariable bkgeditbox(r$j) -width $width] \
	1361	# -column 2 -row 1
	1362	# }
	1363	incr k
	1364	}
	1365	trace variable bkgeditbox w "BkgRecalcPlot $top"
	1366	BkgRecalcPlot $top x x x
	1367	update idletasks
	1368	set sizes [grid bbox $top]
	1369	.bkg.canvas config -scrollregion $sizes -height [lindex $sizes 3]
	1370	# inhibit the save button, if requested
	1371	if {$save == "nosave"} {
	1372	.bkg.cw config -state disabled
	1373	.g element configure 11 -xdata {} -ydata {}
	1374	update
	1375	}
	1376	}
	1377
	1378	# respond to edits made to background terms
	1379	proc BkgRecalcPlot {top var i mode} {
	1380	global bkgeditbox termlist expgui expgui(FitOrder)
	1381
	1382	set good 1
	1383
	1384	set o $expgui(FitOrder)
	1385
	1386	set termlist {}
	1387	for {set j 0} {$j < $o} {incr j} {
	1388	lappend termlist $bkgeditbox($j)
	1389	if {[catch {expr $bkgeditbox($j)}]} {
	1390	$top.$j.e config -fg red
	1391	set good 0
	1392	} else {
	1393	$top.$j.e config -fg black
	1394	}
	1395	}
	1396
	1397	# disable fit for invalid values
	1398	if {$good} {
	1399	.bkg.cw config -state normal
	1400	.bkg.f.fit1 config -state normal
	1401	# plot it
	1402	set calcb [BkgEval $termlist $expgui(FitFunction) \
	1403	[xvec range 0 end] $expgui(RadiiList)]
	1404	.g element configure 11 -xdata xvec -ydata $calcb
	1405	update
	1406	} else {
	1407	.bkg.cw config -state disabled
	1408	.bkg.f.fit1 config -state disabled
	1409	.g element configure 11 -xdata {} -ydata {}
	1410	update
	1411	}
	1412	}
	1413
	1414	# put the bkg points into edit widgets
	1415	proc bkgFillPoints {} {
	1416	global bkglist tmin tmax bkgedit
	1417	# delete trace on bkgedit
	1418	foreach v [ trace vinfo bkgedit] {
	1419	eval trace vdelete bkgedit $v
	1420	}
	1421	catch {destroy .bkg.bc.fr}
	1422	set top [frame .bkg.bc.fr]
	1423	.bkg.bc create window 0 0 -anchor nw -window $top
	1424	if {[llength $bkglist] == 0} {
	1425	grid [label $top.0 -text "(no points defined)"] -column 1 -row 1
	1426	} else {
	1427	set i -1
	1428	foreach p $bkglist {
	1429	incr i
	1430	grid [frame $top.$i -relief groove -bd 3] -column $i -row 1
	1431	grid [label $top.$i.l -text "[expr 1+$i]"] -column 1 -rowspan 2 -row 1
	1432	grid [entry $top.$i.ex -textvariable bkgedit(x$i) -width 13] \
	1433	-column 2 -row 1
	1434	grid [entry $top.$i.ey -textvariable bkgedit(y$i) -width 13] \
	1435	-column 2 -row 2
	1436	foreach val $p var {x y} {
	1437	set bkgedit(${var}$i) $val
	1438	}
	1439	}
	1440	trace variable bkgedit w "BkgRecalcBkg $top"
	1441	}
	1442	update idletasks
	1443	set sizes [grid bbox $top]
	1444	.bkg.bc config -scrollregion $sizes -height [lindex $sizes 3]
	1445	}
	1446
	1447	# respond to edits made to bkg points
	1448	proc BkgRecalcBkg {top var i mode} {
	1449	global bkgedit bkglist tmin tmax
	1450	regexp {(.)([0-9]*)} $i junk var num
	1451	if [catch {expr {$bkgedit($i)}}] {
	1452	$top.$num.e$var config -fg red
	1453	} else {
	1454	$top.$num.e$var config -fg black
	1455	set p [lindex $bkglist $num]
	1456	if {$var == "x"} {
	1457	set x $bkgedit($i)
	1458	if {$x < $tmin} {set x $tmin}
	1459	if {$x > $tmax} {set x $tmax}
	1460	set bkglist [lreplace $bkglist $num $num \
	1461	[list $x [lindex $p 1]]]
	1462	} else {
	1463	set bkglist [lreplace $bkglist $num $num \
	1464	[list [lindex $p 0] $bkgedit($i)]]
	1465	}
	1466	}
	1467	bkgPointPlot
	1468	}
	1469
	1470	# convert x values to Q
	1471	proc bkgtoQ {xlist hst} {
	1472	global expmap
	1473	if {[string range $expmap(htype_$hst) 2 2] == "T"} {
	1474	return [bkgtof2Q $xlist $hst]
	1475	} elseif {[string range $expmap(htype_$hst) 2 2] == "C"} {
	1476	return [tttoQ $xlist $hst]
	1477	} elseif {[string range $expmap(htype_$hst) 2 2] == "E"} {
	1478	return [engtoQ $xlist $hst]
	1479	} else {
	1480	return {}
	1481	}
	1482	}
	1483	# convert tof to Q (as done in BKG routines -- no zero or difa)
	1484	proc bkgtof2Q {toflist hst} {
	1485	set difc [expr {[histinfo $hst difc]/1000.}]
	1486	set 2pi [expr {4.*acos(0.)}]
	1487	set ans {}
	1488	foreach tof $toflist {
	1489	if {$tof == 0.} {
	1490	lappend ans 99999.
	1491	} elseif {$tof == 1000.} {
	1492	lappend ans 0.
	1493	} else {
	1494	lappend ans [expr {$2pi * $difc / $tof}]
	1495	}
	1496	}
	1497	return $ans
	1498	}
	1499
	1500	# convert two-theta to Q
	1501	proc tttoQ {twotheta hst} {
	1502	set lamo2 [expr {0.5 * [histinfo $hst lam1]}]
	1503	set zero [expr [histinfo $hst zero]/100.]
	1504	set ans {}
	1505	set cnv [expr {acos(0.)/180.}]
	1506	set 2pi [expr {4.*acos(0.)}]
	1507	foreach tt $twotheta {
	1508	if {$tt == 0.} {
	1509	lappend ans 0.
	1510	} elseif {$tt == 1000.} {
	1511	lappend ans 1000.
	1512	} else {
	1513	lappend ans [expr {$2pi * sin($cnv*($tt-$zero)) / $lamo2}]
	1514	}
	1515	}
	1516	return $ans
	1517	}
	1518	# convert energy (edx-ray) to Q
	1519	# (note that this ignores the zero correction)
	1520	proc engtoQ {eng hst} {
	1521	set lam [histinfo $hst lam1]
	1522	set zero [histinfo $hst zero]
	1523	set ans {}
	1524	set v [expr {12.398/(2.0*[sind[expr ($lam/2.0)]])}]
	1525	set 2pi [expr {4.*acos(0.)}]
	1526	foreach e $eng {
	1527	if {$e == 0.} {
	1528	lappend ans 0.
	1529	} elseif {$e == 1000.} {
	1530	lappend ans 1000.
	1531	} else {
	1532	lappend ans [expr {$2pi * $e / $v}]
	1533	}
	1534	}
	1535	return $ans
	1536	}
	1537
	1538	proc BkgEval {terms num tlist "rlist {}"} {
	1539	global expmap hst
	1540	if {$num == 1} {
	1541	global tmin tmax
	1542	foreach x $tlist {
	1543	lappend blist [chebeval $terms $x $tmin $tmax]
	1544	}
	1545	return $blist
	1546	} elseif {$num == 2} {
	1547	set ts 1
	1548	if {[string range $expmap(htype_$hst) 2 2] == "T"} {
	1549	catch {
	1550	set line [histinfo $hst ITYP]
	1551	set ts [expr 180./ [lindex $line 2]]
	1552	}
	1553	}
	1554	foreach tof $tlist {
	1555	set tofm [expr {$tof * $ts}]
	1556	set bkg 0
	1557	set i -1
	1558	foreach t $terms {
	1559	incr i
	1560	set bkg [expr {$bkg + $t * cos($i * $tofm * 3.14159/180.)}]
	1561	}
	1562	lappend blist $bkg
	1563	}
	1564	return $blist
	1565	} elseif {$num == 4} {
	1566	set Qlist [bkgtoQ $tlist $hst]
	1567	foreach Q $Qlist {
	1568	set i -1
	1569	set QT 1
	1570	foreach t $terms {
	1571	incr i
	1572	if {$i == 0} {
	1573	set bkg $t
	1574	} else {
	1575	set QT [expr {$QT * $Q * $Q / $i}]
	1576	set bkg [expr {$bkg + $t * $QT}]
	1577	}
	1578	}
	1579	lappend blist $bkg
	1580	}
	1581	return $blist
	1582	} elseif {$num == 5} {
	1583	set Qlist [bkgtoQ $tlist $hst]
	1584	foreach Q $Qlist {
	1585	set i -1
	1586	set QT 1
	1587	foreach t $terms {
	1588	incr i
	1589	if {$i == 0} {
	1590	set bkg $t
	1591	} else {
	1592	set QT [expr {$QT * $i /($Q * $Q)}]
	1593	set bkg [expr {$bkg + $t * $QT}]
	1594	}
	1595	}
	1596	lappend blist $bkg
	1597	}
	1598	return $blist
	1599	} elseif {$num == 6} {
	1600	set Qlist [bkgtoQ $tlist $hst]
	1601	foreach Q $Qlist {
	1602	set i 0
	1603	set QT 1
	1604	foreach t $terms {
	1605	incr i
	1606	if {$i == 1} {
	1607	set bkg $t
	1608	} elseif {$i % 2} {
	1609	# odd
	1610	set QT1 [expr {1./$QT}]
	1611	set bkg [expr {$bkg + $t * $QT1}]
	1612	} else {
	1613	# even
	1614	set QT [expr {2$QT$Q*$Q/$i}]
	1615	set QT1 $QT
	1616	set bkg [expr {$bkg + $t * $QT1}]
	1617	}
	1618	}
	1619	lappend blist $bkg
	1620	}
	1621	return $blist
	1622	}
	1623	}
	1624
	1625	proc backderivcal {nterms num tof "rlist {}"} {
	1626	global expmap hst
	1627	if {$num == 1} {
	1628	global tmin tmax
	1629	# rescale x
	1630	set xs [expr {-1 + 2 * (1.$tof - $tmin) / (1.$tmax - 1.*$tmin)}]
	1631	# compute the Chebyschev term Tn(xs)
	1632	set deriv {}
	1633	set Tpp 0
	1634	set Tp 0
	1635	for {set i 0} {$i < $nterms} {incr i} {
	1636	if {$Tpp == $Tp && $Tp == 0} {
	1637	set T 1
	1638	} elseif {$Tpp == 0} {
	1639	set T $xs
	1640	} else {
	1641	set T [expr {2. * $xs * $Tp - $Tpp}]
	1642	}
	1643	lappend deriv $T
	1644	set Tpp $Tp
	1645	set Tp $T
	1646	}
	1647	return $deriv
	1648	} elseif {$num == 2} {
	1649	set ts 1
	1650	if {[string range $expmap(htype_$hst) 2 2] == "T"} {
	1651	catch {
	1652	set line [histinfo $hst ITYP]
	1653	set ts [expr 180./ [lindex $line 2]]
	1654	}
	1655	set tofm [expr {$tof * $ts}]
	1656	} else {
	1657	set tofm $tof
	1658	}
	1659	set deriv {}
	1660	for {set i 0} {$i < $nterms} {incr i} {
	1661	lappend deriv [expr {cos($i * $tofm * 3.14159/180.)}]
	1662	}
	1663	return $deriv
	1664	} elseif {$num == 3} {
	1665	set Q [bkgtoQ $tof $hst]
	1666	set j -1
	1667	#set n [expr {2 + ($nterms - 2)/2}]
	1668	for {set i 1} {$i <= $nterms} {incr i} {
	1669	if {$i == 1} {
	1670	set deriv 1
	1671	} elseif {$i == 2} {
	1672	lappend deriv $tof
	1673	} else {
	1674	incr j
	1675	set r [lindex $rlist $j]
	1676	set QR [expr {$Q * $r}]
	1677	lappend deriv [expr {sin($QR)/$QR}]
	1678	}
	1679	}
	1680	return $deriv
	1681	} elseif {$num == 4} {
	1682	set Q [bkgtoQ $tof $hst]
	1683	set QT 1
	1684	for {set i 0} {$i < $nterms} {incr i} {
	1685	if {$i == 0} {
	1686	set deriv 1
	1687	} else {
	1688	lappend deriv [set QT [expr {$QT * $Q * $Q / $i}]]
	1689	}
	1690	}
	1691	return $deriv
	1692	} elseif {$num == 5} {
	1693	set Q [bkgtoQ $tof $hst]
	1694	set QT 1
	1695	for {set i 0} {$i < $nterms} {incr i} {
	1696	if {$i == 0} {
	1697	set deriv 1
	1698	} else {
	1699	lappend deriv [set QT [expr {$QT * $i /($Q * $Q)}]]
	1700	}
	1701	}
	1702	return $deriv
	1703	} elseif {$num == 6} {
	1704	set Q [bkgtoQ $tof $hst]
	1705	set QT 1
	1706	for {set i 1} {$i <= $nterms} {incr i} {
	1707	if {$i == 1} {
	1708	set deriv 1
	1709	} elseif {$i % 2} {
	1710	# odd
	1711	lappend deriv [set QT1 [expr {1./$QT}]]
	1712	} else {
	1713	# even
	1714	set QT [expr {2$QT$Q*$Q/$i}]
	1715	lappend deriv [set QT1 $QT]
	1716	}
	1717	}
	1718	return $deriv
	1719	}
	1720	}
	1721
	1722	# evaluate the best-fit background terms to fit GSAS background functions 1-6
	1723	# to a set of X and Y values.
	1724	# num is the function number,
	1725	# order is the # of terms
	1726	# rlist is used only for function type 3; there must be (order-2)/2 values
	1727	proc FitBkgFunc {X Y order num "rlist {}"} {
	1728	if {$num == 3} {
	1729	set o [expr {2 + ($order - 2)/2}]
	1730	} else {
	1731	set o $order
	1732	}
	1733	# zero the matrix and vector
	1734	for {set j 0} {$j < $o} {incr j} {
	1735	set sum($j) 0.
	1736	for {set i 0} {$i <= $j} {incr i} {
	1737	set sum(${i}_$j) 0.
	1738	}
	1739	}
	1740	#global octave
	1741	#set octave {}
	1742	#append octave {des = [}
	1743	foreach y $Y x $X {
	1744	# compute derivatives at point x
	1745	set derivlist [backderivcal $o $num $x $rlist]
	1746	#append octave " $derivlist ;\n"
	1747	# compute matrix elements
	1748	for {set j 0} {$j < $o} {incr j} {
	1749	set Tj [lindex $derivlist $j]
	1750	# weighted
	1751	# set sum($j) [expr {$sum($j) + $y * $Tj / ($sigma*$sigma)}]
	1752	set sum($j) [expr {$sum($j) + $y * $Tj}]
	1753	for {set i 0} {$i <= $j} {incr i} {
	1754	set Ti [lindex $derivlist $i]
	1755	# weighted
	1756	# set sum(${i}_$j) [expr {$sum(${i}_$j) + $Ti * $Tj / ($sigma * $sigma)}]
	1757	set sum(${i}_$j) [expr {$sum(${i}_$j) + $Ti * $Tj}]
	1758	}
	1759	}
	1760	}
	1761	# populate the matrix & vector in La format
	1762	lappend V 2 $o 0
	1763	lappend A 2 $o $o
	1764	for {set i 0} {$i < $o} {incr i} {
	1765	lappend V $sum($i)
	1766	for {set j 0} {$j < $o} {incr j} {
	1767	if {$j < $i} {
	1768	lappend A $sum(${j}_$i)
	1769	} else {
	1770	lappend A $sum(${i}_$j)
	1771	}
	1772	}
	1773	}
	1774	set termlist {}
	1775	if {[catch {
	1776	set termlist [lrange [La::msolve $A $V] 3 end]
	1777	}]} {
	1778	tk_dialog .singlar "Singular Matrix" \
	1779	"Unable to fit function: singular matrix. Too many terms or something else is wrong." ""\
	1780	0 OK
	1781	}
	1782	return $termlist
	1783	}
	1784
	1785	# save the Chebyshev terms in the .EXP file
	1786	proc bkgSave {} {
	1787	# results not saved in the Macro file
	1788	global hst termlist expgui Revision expmap expnam
	1789	histinfo $hst backtype set $expgui(FitFunction)
	1790	# stick the r values into the list
	1791	# if {$expgui(FitFunction) == 3} {
	1792	# set t [lrange $termlist 0 1]
	1793	# foreach a [lrange $termlist 2 end] b $expgui(RadiiList) {lappend t $a $b}
	1794	# } else {
	1795	set t $termlist
	1796	# }
	1797	histinfo $hst backterms set [llength $t]
	1798	set num 0
	1799	foreach v $t {
	1800	set var "bterm[incr num]"
	1801	histinfo $hst $var set $v
	1802	}
	1803	histinfo $hst bref set 0
	1804	# add a history record
	1805	exphistory add " BKGEDIT [lindex $Revision 1] [lindex $expmap(Revision) 1] -- [clock format [clock seconds]]"
	1806	# now save the file
	1807	expwrite $expnam.EXP
	1808	}
	1809
	1810	#-------------------------------------------------------------------------
	1811	# manual zoom option
	1812	proc BLTmanualZoom {} {
	1813	global graph
	1814	catch {toplevel .zoom}
	1815	eval destroy [grid slaves .zoom]
	1816	raise .zoom
	1817	wm title .zoom {Manual Scaling}
	1818	grid [label .zoom.l1 -text minimum] -row 1 -column 2
	1819	grid [label .zoom.l2 -text maximum] -row 1 -column 3
	1820	grid [label .zoom.l3 -text x] -row 2 -column 1
	1821	grid [label .zoom.l4 -text y] -row 3 -column 1
	1822	grid [entry .zoom.xmin -textvariable graph(xmin) -width 10] -row 2 -column 2
	1823	grid [entry .zoom.xmax -textvariable graph(xmax) -width 10] -row 2 -column 3
	1824	grid [entry .zoom.ymin -textvariable graph(ymin) -width 10] -row 3 -column 2
	1825	grid [entry .zoom.ymax -textvariable graph(ymax) -width 10] -row 3 -column 3
	1826	grid [frame .zoom.b] -row 4 -column 1 -columnspan 3
	1827	grid [button .zoom.b.1 -text "Set Scaling" \
	1828	-command "SetManualZoom set"] -row 4 -column 1 -columnspan 2
	1829	grid [button .zoom.b.2 -text Reset \
	1830	-command "SetManualZoom clear"] -row 4 -column 3
	1831	grid [button .zoom.b.3 -text Close -command "destroy .zoom"] -row 4 -column 4
	1832	grid rowconfigure .zoom 1 -weight 1 -pad 5
	1833	grid rowconfigure .zoom 2 -weight 1 -pad 5
	1834	grid rowconfigure .zoom 3 -weight 1 -pad 5
	1835	grid rowconfigure .zoom 4 -weight 0 -pad 5
	1836	grid columnconfigure .zoom 1 -weight 1 -pad 20
	1837	grid columnconfigure .zoom 1 -weight 1
	1838	grid columnconfigure .zoom 3 -weight 1 -pad 10
	1839	foreach item {min min max max} \
	1840	format {3 2 3 2} \
	1841	axis {x y x y} {
	1842	set val [$graph(blt) ${axis}axis cget -${item}]
	1843	set graph(${axis}${item}) {(auto)}
	1844	catch {set graph(${axis}${item}) [format %.${format}f $val]}
	1845	}
	1846	bind .zoom <Return> "SetManualZoom set"
	1847	}
	1848
	1849	proc SetManualZoom {mode} {
	1850	global graph
	1851	if {$mode == "clear"} {
	1852	foreach item {xmin ymin xmax ymax} {
	1853	set graph($item) {(auto)}
	1854	}
	1855	}
	1856	foreach item {xmin ymin xmax ymax} {
	1857	if {[catch {expr $graph($item)}]} {
	1858	set $item ""
	1859	} else {
	1860	set $item $graph($item)
	1861	}
	1862	}
	1863	# reset the zoomstack
	1864	catch {Blt_ZoomStack $graph(blt)}
	1865	catch {$graph(blt) xaxis config -min $xmin -max $xmax}
	1866	catch {$graph(blt) yaxis config -min $ymin -max $ymax}
	1867	global program
	1868	if {$program == "bkgedit"} {bkgEditMode ""}
	1869	}
	1870
	1871	# define a binding to show the cursor location
	1872	proc ToggleLiveCursor {} {
	1873	global box graph
	1874	if {[bind $box <Any-Motion>] == ""} {
	1875	.a.options.menu entryconfig $graph(CursorLabel) -label "Hide Cursor Position"
	1876	pack [frame .bot -bd 2 -relief sunken] -side bottom -fill x
	1877	pack [label .bot.val1 -textvariable graph(position)] -side left
	1878	pack [button .bot.close -command ToggleLiveCursor -text "Close cursor display"] -side right
	1879	bind $box <Any-Motion> {FormatLiveCursor %x %y}
	1880	} else {
	1881	.a.options.menu entryconfig $graph(CursorLabel) -label "Show Cursor Position"
	1882	destroy .bot
	1883	bind $box <Any-Motion> {}
	1884	}
	1885	}
	1886	proc FormatLiveCursor {x y} {
	1887	global graph
	1888	set graph(position) \
	1889	"x=[format %.3f [$graph(blt) xaxis invtransform $x]] y=[format %.3f [$graph(blt) yaxis invtransform $y]]"
	1890	}
	1891
	1892	#-------------------------------------------------------------------------
	1893	# override options with locally defined values
	1894	set filelist [file join $expgui(scriptdir) localconfig]
	1895	if {$tcl_platform(platform) == "windows"} {
	1896	lappend filelist "c:/gsas.config"
	1897	} else {
	1898	lappend filelist [file join ~ .gsas_config]
	1899	}
	1900	if {[catch {
	1901	foreach file $filelist {
	1902	if [file exists $file] {source $file}
	1903	}
	1904	} errmsg]} {
	1905	set msg "Error reading file $file (aka [file nativename $file]): $errmsg"
	1906	MyMessageBox -parent . -title "Customize warning" \
	1907	-message $msg -icon warning -type Ignore -default ignore \
	1908	-helplink "expguierr.html Customizewarning"
	1909	}
	1910
	1911	SetTkDefaultOptions $expgui(font)
	1912
	1913	if [file executable [file join $expgui(gsasexe) $expgui(tcldump)]] {
	1914	set expgui(tcldump) [file join $expgui(gsasexe) $expgui(tcldump)]
	1915	} else {
	1916	set expgui(tcldump) {}
	1917	}
	1918
	1919	# vectors
	1920	if [catch {
	1921	foreach vec {xvec obsvec calcvec bckvec diffvec refposvec wifdvec} {
	1922	vector $vec
	1923	$vec notify never
	1924	}
	1925	} errmsg] {
	1926	MyMessageBox -parent . -title "BLT Error" \
	1927	-message "BLT Setup Error: could not define vectors \
	1928	(msg: $errmsg). \
	1929	$program cannot be run without vectors." \
	1930	-helplink "expgui.html blt" \
	1931	-icon error -type Skip -default skip
	1932	exit
	1933	}
	1934
	1935	# create the graph
	1936	if [catch {
	1937	set box [graph .g -plotbackground white]
	1938	set graph(blt) $box
	1939	} errmsg] {
	1940	MyMessageBox -parent . -title "BLT Error" \
	1941	-message "BLT Setup Error: could not create a graph \
	1942	(error msg: $errmsg). \
	1943	There is a problem with the setup of BLT on your system. \
	1944	See the expgui.html file for more info." \
	1945	-helplink "expgui.html blt" \
	1946	-icon warning -type Exit -default "exit"
	1947	exit
	1948	}
	1949	if [catch {
	1950	Blt_ZoomStack $box
	1951	} errmsg] {
	1952	MyMessageBox -parent . -title "BLT Error" \
	1953	-message "BLT Setup Error: could not access a Blt_ routine \
	1954	(msg: $errmsg). \
	1955	The pkgIndex.tcl is probably not loading bltGraph.tcl.
	1956	See the expgui.html file for more info." \
	1957	-helplink "expgui.html blt" \
	1958	-icon warning -type {"Limp Ahead"} -default "limp Ahead"
	1959	}
	1960	# modify zoom so that y2axis is not zoomed in for blt2.4u+
	1961	catch {
	1962	regsub -all y2axis [info body blt::PushZoom] " " b1
	1963	proc blt::PushZoom {graph} $b1
	1964	}
	1965	# get binding for zoom
	1966	set graph(bindtag) $box
	1967	catch {
	1968	if {[bind zoom-$box] != ""} {
	1969	# blt2.4z
	1970	set graph(bindtag) zoom-$box
	1971	} elseif {[bind bltZoomGraph] != ""} {
	1972	# blt2.4?
	1973	set graph(bindtag) bltZoomGraph
	1974	}
	1975	}
	1976
	1977	$box element create 0 -xdata xvec -ydata wifdvec \
	1978	-line 3 -symbol none -label "Chi2" -mapy y2
	1979	catch {$box element config 0 -color $graph(color_chi2)}
	1980
	1981	$box element create 1 -label bckgr -symbol none
	1982	$box element config 1 -xdata xvec -ydata bckvec
	1983	catch {$box element config 1 -color $graph(color_bkg)}
	1984	$box element create 3 -linewidth 0 -label Obs
	1985	catch {$box element configure 3 -symbol $peakinfo(obssym)}
	1986	catch {$box element configure 3 -color $graph(color_obs)}
	1987	catch {$box element configure 3 -pixels [expr 0.125 * $peakinfo(obssize)]i}
	1988	$box element create 2 -label Calc -symbol none
	1989	catch {$box element config 2 -color $graph(color_calc)}
	1990	$box element create 4 -label diff -symbol none
	1991	catch {$box element config 4 -color $graph(color_diff)}
	1992
	1993	if {$program == "liveplot"} {
	1994	$box y2axis config -title {Cumulative Chi Squared}
	1995	catch {$box y2axis config -min 0}
	1996	} elseif {$program == "bkgedit"} {
	1997	eval $box element config 0 $graph(ElementHideOption)
	1998	eval $box y2axis config $graph(ElementHideOption)
	1999	$box element config 0 -label ""
	2000	eval $box element config 1 $graph(ElementHideOption)
	2001	$box element config 1 -label ""
	2002	eval $box element config 4 $graph(ElementHideOption)
	2003	$box element config 4 -label ""
	2004	$box element create 11
	2005	$box element create 12
	2006	$box element configure 12 -line 0 -label "bkg pts"
	2007	catch {$box element config 12 -color $graph(color_input)}
	2008	catch {$box element config 12 -pixels [expr 0.125 * $peakinfo(inpsize)]i}
	2009	catch {$box element config 12 -symbol $peakinfo(inpsym)}
	2010	$box element configure 11 -symbol none -label "bkg fit" -dashes 5 -line 2
	2011	catch {$box element config 11 -color $graph(color_fit)}
	2012	$box element show "3 2 11 12"
	2013	}
	2014	$box element config 3 -xdata xvec -ydata obsvec
	2015	$box element config 2 -xdata xvec -ydata calcvec
	2016	$box element config 4 -xdata xvec -ydata diffvec
	2017
	2018	if {$expgui(tcldump) != ""} {
	2019	bind . <Key-h> "lblhkl $box %x"
	2020	bind . <Key-H> "lblhkl $box %x"
	2021	bind . <Key-a> "lblhkl $box all"
	2022	bind . <Key-A> "lblhkl $box all"
	2023	bind . <Key-d> "delallhkllbl $box"
	2024	bind . <Key-D> "delallhkllbl $box"
	2025	bind $graph(bindtag) <Shift-Button-1> "lblhkl $box %x"
	2026	bind $graph(bindtag) <Shift-Button-3> "delallhkllbl %W"
	2027	} else {
	2028	$box element config 1 -label ""
	2029	eval $box element config 4 $graph(ElementHideOption)
	2030	}
	2031	bind . <Key-z> {BLTmanualZoom}
	2032	bind . <Key-Z> {BLTmanualZoom}
	2033
	2034	$box yaxis config -title {}
	2035	setlegend $box $graph(legend)
	2036
	2037	frame .a -bd 3 -relief groove
	2038	pack [menubutton .a.file -text File -underline 0 -menu .a.file.menu] -side left
	2039	menu .a.file.menu
	2040	.a.file.menu add cascade -label Tickmarks -menu .a.file.menu.tick
	2041	menu .a.file.menu.tick
	2042	.a.file.menu add cascade -label Histogram -menu .a.file.menu.hist -state disabled
	2043	.a.file.menu add command -label "Update Plot" \
	2044	-command {set cycle [getcycle];readdata .g}
	2045	.a.file.menu add cascade -label "Export plot" -menu .a.file.menu.export
	2046	menu .a.file.menu.export
	2047	.a.file.menu.export add command -label "to PostScript" \
	2048	-command makepostscriptout
	2049	if {$blt_version > 2.3 && $blt_version != 8.0} {
	2050	source [file join $expgui(scriptdir) graceexport.tcl]
	2051	.a.file.menu.export add command -label "to Grace" -command exportgrace
	2052	}
	2053	.a.file.menu add command -label Quit -command "destroy ."
	2054	.a.file.menu.export add command -label "as .csv file" \
	2055	-command makecsvfile
	2056	# source additional export routines
	2057	set filelist [glob -nocomplain [file join $expgui(scriptdir) liveplot_*.tcl]]
	2058	foreach file $filelist {
	2059	if [catch {
	2060	source $file
	2061	.a.file.menu.export add command -label $label -command $action
	2062	} errmsg] {catch {puts "source error = $errmsg"}}
	2063	}
	2064	pack [menubutton .a.options -text Options -underline 0 -menu .a.options.menu] \
	2065	-side left
	2066	menu .a.options.menu
	2067	.a.options.menu add cascade -label "Configure Tickmarks" -menu .a.options.menu.tick
	2068	menu .a.options.menu.tick
	2069	.a.options.menu.tick add radiobutton -label "Manual Placement" \
	2070	-value 0 -variable expgui(autotick) -command plotdata
	2071	.a.options.menu.tick add radiobutton -label "Auto locate" \
	2072	-value 1 -variable expgui(autotick) -command plotdata
	2073	.a.options.menu.tick add separator
	2074	.a.options.menu.tick add command -label "Label by name" \
	2075	-command {
	2076	foreach p $expmap(phaselist) {
	2077	# 20 characters, max
	2078	set graph(label$p) [string range [phaseinfo $p name] 0 19]
	2079	plotdata
	2080	}
	2081	}
	2082	.a.options.menu.tick add separator
	2083
	2084	if {$program == "liveplot"} {
	2085	.a.options.menu add command -label "Obs symbol" -command getsymopts
	2086	} else {
	2087	.a.options.menu add cascade -label "Symbol Type" -menu .a.options.menu.sym
	2088	menu .a.options.menu.sym
	2089	foreach var {obs inp} lbl {Observed "Input bkg"} {
	2090	.a.options.menu.sym add command -label $lbl -command "getsymopts $var"
	2091	}
	2092	}
	2093	.a.options.menu add cascade -label "Symbol color" -menu .a.options.menu.color
	2094	menu .a.options.menu.color
	2095	set l1 {obs calc diff bkg chi2 OmCoS}
	2096	set l2 {Observed Calculated Obs-Calc Background Cumulative-Chi2 (obs-calc)/sig}
	2097	if {$program != "liveplot"} {
	2098	lappend l1 input fit
	2099	lappend l2 "Input points" "bkg fit"
	2100	}
	2101
	2102	foreach var $l1 lbl $l2 {
	2103	.a.options.menu.color add command -label $lbl \
	2104	-command "setSymcolor $var $lbl; plotdata"
	2105	}
	2106	if {$expgui(tcldump) != "" && $program == "liveplot"} {
	2107	.a.options.menu add cascade -label "X units" -menu .a.options.menu.xunits
	2108	menu .a.options.menu.xunits
	2109	.a.options.menu.xunits add radiobutton -label "As collected" \
	2110	-variable graph(xunits) -value 0 \
	2111	-command {set cycle [getcycle];readdata .g}
	2112	.a.options.menu.xunits add radiobutton -label "d-space" \
	2113	-variable graph(xunits) -value 1 \
	2114	-command {set cycle [getcycle];readdata .g}
	2115	.a.options.menu.xunits add radiobutton -label "Q" \
	2116	-variable graph(xunits) -value 2 \
	2117	-command {set cycle [getcycle];readdata .g}
	2118	.a.options.menu add cascade -label "Y units" -menu .a.options.menu.yunits
	2119	menu .a.options.menu.yunits
	2120	.a.options.menu.yunits add radiobutton -label "As collected" \
	2121	-variable graph(yunits) -value 0 \
	2122	-command {set cycle [getcycle];readdata .g}
	2123	.a.options.menu.yunits add radiobutton -label "Normalized" \
	2124	-variable graph(yunits) -value 1 \
	2125	-command {set cycle [getcycle];readdata .g}
	2126	.a.options.menu add command -label "HKL labeling" -command setlblopts
	2127	.a.options.menu add checkbutton -label "Subtract background" \
	2128	-variable graph(backsub) \
	2129	-command {set cycle [getcycle];readdata .g}
	2130	} else {
	2131	set graph(xunits) 0
	2132	}
	2133
	2134	.a.options.menu add checkbutton -label "Include legend" \
	2135	-variable graph(legend) \
	2136	-command {setlegend $box $graph(legend)}
	2137	.a.options.menu add command -label "Show Cursor Position" \
	2138	-command ToggleLiveCursor
	2139	set graph(CursorLabel) [.a.options.menu index "Show Cursor Position"]
	2140	.a.options.menu add command -label "Set PS output" -command setpostscriptout
	2141	.a.options.menu add cascade -menu .a.options.menu.font \
	2142	-label "Screen font"
	2143	menu .a.options.menu.font
	2144	foreach f {10 11 12 13 14 16 18 20 22} {
	2145	.a.options.menu.font add radiobutton \
	2146	-command {SetTkDefaultOptions $expgui(font); ResizeFont .} \
	2147	-label $f -value $f -variable expgui(font) -font "Helvetica -$f"
	2148	}
	2149	if {$program == "liveplot"} {
	2150	.a.options.menu add checkbutton -label "Raise on update" \
	2151	-variable graph(autoraise)
	2152	.a.options.menu add checkbutton -label "Cumulative Chi2" \
	2153	-variable graph(chi2) \
	2154	-command "set graph(OmCoS) 0; ShowCumulativeChi2"
	2155	.a.options.menu add checkbutton -label "(Obs-Calc)/sig" \
	2156	-variable graph(OmCoS) \
	2157	-command "set graph(chi2) 0; ShowCumulativeChi2"
	2158	.a.options.menu add command -label "Save Options" -underline 1 \
	2159	-command "SaveOptions"
	2160	ShowCumulativeChi2
	2161	} elseif {$program == "bkgedit"} {
	2162	catch {pack [frame .bkg -bd 3 -relief sunken] -side bottom -fill both}
	2163	# grid [label .bkg.top -text "Background Point Editing"] \
	2164	# -column 0 -row 0 -columnspan 4
	2165	# grid [button .bkg.help -text Help -bg yellow \
	2166	# -command "MakeWWWHelp liveplot.html bkgedit"] \
	2167	# -column 5 -row 0 -rowspan 2 -sticky n
	2168
	2169	grid [frame .bkg.l -bd 3 -relief groove] \
	2170	-column 0 -row 1 -columnspan 2 -sticky nse
	2171	grid [label .bkg.l.1 -text "Mouse click\naction"] -column 0 -row 0
	2172	foreach c {1 2 3} l {zoom add delete} {
	2173	grid [button .bkg.l.b$c -text $l -command "bkgEditMode $c"] \
	2174	-column $c -row 0
	2175	}
	2176	# leave a small blank space
	2177	grid columnconfigure .bkg 2 -pad 0 -min 10
	2178	grid [frame .bkg.f -bd 3 -relief groove] \
	2179	-column 3 -row 1 -columnspan 2 -sticky nsw
	2180	grid [button .bkg.f.fit1 -text "Fit" -command {bkgFit .bkg.f.fit1}] \
	2181	-column 1 -row 1
	2182	grid [label .bkg.f.tl -text "with"] -column 3 -row 1
	2183	set termmenu [tk_optionMenu .bkg.f.terms expgui(FitOrder) 0]
	2184	grid .bkg.f.terms -column 4 -row 1
	2185	grid [label .bkg.f.tl1 -text "terms"] -column 5 -row 1
	2186
	2187	grid [frame .bkg.c1 -bd 3 -relief groove] \
	2188	-column 0 -row 5 -rowspan 2 -sticky nsew
	2189	grid [label .bkg.c1.0 -text "Background\nfunction #"] -column 0 -row 0
	2190	set bkgmenu [tk_optionMenu .bkg.c1.1 expgui(FitFunction) stuff]
	2191	grid .bkg.c1.1 -column 0 -row 1
	2192	$bkgmenu delete 0 end
	2193	foreach item {
	2194	"1 - Shifted Chebyschev polynomial"
	2195	"2 - Cosine Fourier series"
	2196	"4 - Power series in Q**2n/n!"
	2197	"5 - Power series in n!/Q**2n"
	2198	"6 - Power series in Q2n/n! and n!/Q2n"
	2199	} {
	2200	set val [lindex $item 0]
	2201	$bkgmenu insert end radiobutton -variable expgui(FitFunction) \
	2202	-label $item -value $val \
	2203	-command "set termlist {};BkgFillTermBoxes nosave"
	2204	}
	2205	# "3 - Radial distribution peaks"
	2206	set expgui(FitFunction) 1
	2207
	2208	grid [canvas .bkg.canvas \
	2209	-scrollregion {0 0 5000 500} -width 0 -height 0 \
	2210	-xscrollcommand ".bkg.scroll set"] \
	2211	-column 1 -row 5 -columnspan 3 -sticky nsew
	2212	grid [scrollbar .bkg.scroll -command ".bkg.canvas xview" \
	2213	-orient horizontal] -column 1 -row 6 -columnspan 3 -sticky nsew
	2214	grid [button .bkg.cw -text "Save in\nEXP file\n& Exit" \
	2215	-command "bkgSave;exit"] \
	2216	-column 4 -columnspan 2 -row 5 -rowspan 2 -sticky ns
	2217
	2218	grid [frame .bkg.bl -bd 3 -relief groove] \
	2219	-column 0 -row 3 -rowspan 2 -sticky nsew
	2220	grid [label .bkg.bl.1 -text "Background\npoints"] -column 0 -row 0
	2221	grid [canvas .bkg.bc \
	2222	-scrollregion {0 0 5000 500} -width 0 -height 0 \
	2223	-xscrollcommand ".bkg.bs set"] \
	2224	-column 1 -row 3 -columnspan 5 -sticky nsew
	2225	grid [scrollbar .bkg.bs -command ".bkg.bc xview" -orient horizontal] \
	2226	-column 1 -row 4 -columnspan 5 -sticky nsew
	2227
	2228	grid columnconfigure .bkg 1 -weight 1
	2229	grid columnconfigure .bkg 2 -weight 1
	2230	grid columnconfigure .bkg 3 -weight 1
	2231	grid rowconfigure .bkg 3 -weight 1
	2232	grid rowconfigure .bkg 5 -weight 1
	2233	.g config -title ""
	2234	}
	2235
	2236	pack [menubutton .a.help -text Help -underline 0 -menu .a.help.menu] -side right
	2237	menu .a.help.menu -tearoff 0
	2238	if {$program == "bkgedit"} {
	2239	.a.help.menu add command -command "MakeWWWHelp liveplot.html bkgedit" \
	2240	-label "Web page"
	2241	} else {
	2242	.a.help.menu add command -command "MakeWWWHelp liveplot.html" \
	2243	-label "Web page"
	2244	}
	2245	if {![catch {package require tkcon} errmsg]} {
	2246	.a.help.menu add command -label "Open console" -command {tkcon show}
	2247	} elseif {$tcl_platform(platform) == "windows"} {
	2248	.a.help.menu add command -label "Open console" -command {console show}
	2249	}
	2250	.a.help.menu add command -command aboutliveplot -label About
	2251
	2252	pack .a -side top -fill both
	2253	pack $box -fill both -expand yes
	2254
	2255	# assume cmpr is in the same location as GSAS
	2256	lappend cmprdir [file join [file dirname $expgui(scriptdir)] cmpr]
	2257
	2258	# append to the list a number of other likely places where CMPR might be found
	2259	if {$tcl_platform(platform) == "windows"} {
	2260	lappend cmprdir c:/cmpr "c:/Program files/cmpr"
	2261	} else {
	2262	lappend cmprdir /usr/local/cmpr ~/cmpr
	2263	}
	2264	# add the CMPR & LOGIC interface options
	2265	set CMPR_OK 0
	2266	foreach dir $cmprdir {
	2267	if {[file exists [set file [file join $dir cellgen.tcl]]]} {
	2268	if {[catch {source $file} errmsg]} {
	2269	catch {puts "source $file error = $errmsg"}
	2270	} else {
	2271	if {$CMPR_OK} {
	2272	catch {
	2273	pack [menubutton .a.peaks -text "Peak Gen" \
	2274	-underline 0 -menu .a.peaks.menu] \
	2275	-side left
	2276	menu .a.peaks.menu
	2277	}
	2278	.a.peaks.menu add command -label "Display a cell" \
	2279	-command {cellgen .cell}
	2280	break
	2281	}
	2282	}
	2283	}
	2284	}
	2285
	2286	set CMPR_OK 0
	2287	foreach dir $cmprdir {
	2288	if {[file exists [set file [file join $dir logic icddcmd.tcl]]]} {
	2289	if {[catch {source $file} errmsg]} {
	2290	catch {puts "source $file error = $errmsg"}
	2291	} else {
	2292	if {$CMPR_OK} {
	2293	catch {
	2294	pack [menubutton .a.peaks -text "Peak Gen" \
	2295	-underline 0 -menu .a.peaks.menu] \
	2296	-side left
	2297	menu .a.peaks.menu
	2298	}
	2299	.a.peaks.menu add command -label "Plot ICDD Entry" \
	2300	-command MakeLogicWin
	2301	break
	2302	}
	2303	}
	2304	}
	2305	}
	2306
	2307	expload $expnam.EXP
	2308	mapexp
	2309
	2310	# fill the histogram menu
	2311	if {[llength $expmap(powderlist)] > 15} {
	2312	set expgui(plotlist) {}
	2313	.a.file.menu entryconfigure Histogram -state normal
	2314	menu .a.file.menu.hist
	2315	set i 0
	2316	foreach num [lsort -integer $expmap(powderlist)] {
	2317	incr i
	2318	# for now include, but disable histograms
	2319	set state disabled
	2320	if {[string range $expmap(htype_$num) 3 3] != "*"} {
	2321	set state normal
	2322	lappend expgui(plotlist) $num
	2323	}
	2324	if {$i == 1} {
	2325	set num1 $num
	2326	menu .a.file.menu.hist.$num1
	2327	}
	2328	.a.file.menu.hist.$num1 add radiobutton -label $num -value $num \
	2329	-variable hst -state $state \
	2330	-command {set cycle [getcycle];readdata .g}
	2331	if {$i >= 10} {
	2332	set i 0
	2333	.a.file.menu.hist add cascade -label "$num1-$num" \
	2334	-menu .a.file.menu.hist.$num1
	2335	}
	2336	}
	2337	if {$i != 0} {
	2338	.a.file.menu.hist add cascade -label "$num1-$num" \
	2339	-menu .a.file.menu.hist.$num1
	2340	}
	2341	} elseif {[llength $expmap(powderlist)] > 1} {
	2342	set expgui(plotlist) {}
	2343	.a.file.menu entryconfigure Histogram -state normal
	2344	menu .a.file.menu.hist
	2345	foreach num [lsort -integer $expmap(powderlist)] {
	2346	# for now include, but disable unprocessed histograms
	2347	set state disabled
	2348	if {[string range $expmap(htype_$num) 3 3] != "*"} {
	2349	set state normal
	2350	lappend expgui(plotlist) $num
	2351	}
	2352	.a.file.menu.hist add radiobutton -label $num -value $num \
	2353	-variable hst -state $state \
	2354	-command {set cycle [getcycle];readdata .g}
	2355	}
	2356	} else {
	2357	set expgui(plotlist) [lindex $expmap(powderlist) 0]
	2358	}
	2359
	2360	foreach num $expmap(phaselist) {
	2361	.a.file.menu.tick add checkbutton -label "Phase $num" \
	2362	-variable peakinfo(flag$num) \
	2363	-command plotdata
	2364	if {$program != "bkgedit"} {
	2365	bind . <Key-$num> ".a.file.menu.tick invoke [.a.file.menu.tick index end]"
	2366	}
	2367	.a.options.menu.tick add command -label "Phase $num opts" \
	2368	-command "minioptionsbox $num"
	2369	}
	2370
	2371	# N = load next histogram
	2372	bind . <Key-n> {
	2373	set i [lsearch $expgui(plotlist) $hst]
	2374	incr i
	2375	if {$i >= [llength $expgui(plotlist)]} {set i 0}
	2376	set hst [lindex $expgui(plotlist) $i]
	2377	set cycle [getcycle];readdata .g
	2378	}
	2379	bind . <Key-N> {
	2380	set i [lsearch $expgui(plotlist) $hst]
	2381	incr i
	2382	if {$i >= [llength $expgui(plotlist)]} {set i 0}
	2383	set hst [lindex $expgui(plotlist) $i]
	2384	set cycle [getcycle];readdata .g
	2385	}
	2386	bind . <Key-l> {ToggleLiveCursor}
	2387	bind . <Key-L> {ToggleLiveCursor}
	2388	# move the zoom region around
	2389	proc ScanZoom {box key frac} {
	2390	foreach var {xl xh yl yh} axis {xaxis xaxis yaxis yaxis} \
	2391	flg {-min -max -min -max} {
	2392	set $var [$box $axis cget $flg]
	2393	if {$var == ""} return
	2394	}
	2395	catch {
	2396	switch -- $key {
	2397	Right {set a x; set l $xl; set h $xh; set d [expr {$frac*($h-$l)}]}
	2398	Left {set a x; set l $xl; set h $xh; set d [expr {-$frac*($h-$l)}]}
	2399	Up {set a y; set l $yl; set h $yh; set d [expr {$frac*($h-$l)}]}
	2400	Down {set a y; set l $yl; set h $yh; set d [expr {-$frac*($h-$l)}]}
	2401	}
	2402	$box ${a}axis configure -min [expr {$l + $d}] -max [expr {$h + $d}]
	2403	}
	2404	}
	2405	bind . <Key-Up> "ScanZoom $box %K .1"
	2406	bind . <Key-Left> "ScanZoom $box %K .1"
	2407	bind . <Key-Right> "ScanZoom $box %K .1"
	2408	bind . <Key-Down> "ScanZoom $box %K .1"
	2409	bind . <Control-Key-Up> "ScanZoom $box %K 1.0"
	2410	bind . <Control-Key-Left> "ScanZoom $box %K 1.0"
	2411	bind . <Control-Key-Right> "ScanZoom $box %K 1.0"
	2412	bind . <Control-Key-Down> "ScanZoom $box %K 1.0"
	2413	# seems to be needed in OSX
	2414	update
	2415	wm geom . [winfo reqwidth .]x[winfo reqheight .]
	2416	#
	2417	updateifnew
	2418	donewaitmsg
	2419	trace variable peakinfo w plotdataupdate

Note: See TracBrowser for help on using the repository browser.

Download in other formats: