Context Navigation

source: trunk/liveplot @ 1181

Last change on this file since 1181 was 1181, checked in by toby, 9 years ago
move Topas-able liveplot to stable release
Property svn:keywords set to `Author Date Revision Id`
File size: 92.4 KB

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

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

Download in other formats: