Context Navigation

source: trunk/liveplot @ 795

Last change on this file since 795 was 795, checked in by toby, 11 years ago
# on 2004/05/13 23:44:04, toby did: add open console deal with starkit problems ignore bad element attributes (colors, marker types, sizes...) update binding stuff (yet again!) avoid bug on fit with no points (bkgfit)
Property rcs:author set to `toby` Property rcs:date set to `2004/05/13 23:44:04` Property rcs:lines set to `+74 -48` Property rcs:rev set to `1.40` Property rcs:state set to `Exp` Property svn:keywords set to `Author Date Revision Id`
File size: 72.4 KB

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

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

Download in other formats: