Context Navigation

← Previous Revision
Next Revision →
Blame
Revision Log

source: trunk/liveplot

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

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

Context Navigation

source: trunk/liveplot

Download in other formats: