Context Navigation

source: trunk/liveplot @ 489

Last change on this file since 489 was 489, checked in by toby, 13 years ago
# on 2001/11/19 19:50:05, toby did: improve error message deal with duplicate points in BKGEDIT
Property rcs:author set to `toby` Property rcs:date set to `2001/11/19 19:50:05` Property rcs:lines set to `+10 -4` Property rcs:rev set to `1.23` Property rcs:state set to `Exp` Property svn:keywords set to `Author Date Revision Id`
File size: 53.4 KB

Line
1	#!/usr/local/bin/wish
2	# $Id: liveplot 489 2009-12-04 23:07:01Z toby $
3	set Revision {$Revision: 489 $ $Date: 2009-12-04 23:07:01 +0000 (Fri, 04 Dec 2009) $}
4
5	bind all <Control-KeyPress-c> {destroy .}
6	# process command line arguments
7	set exitstat 0
8	set expnam [lindex $argv 0]
9	if {$expnam == ""} {puts "error -- no experiment name"; set exitstat 1}
10	if $exitstat {
11	puts "usage: $argv0 expnam \[hist #\] \[legend\]"
12	destroy .
13	}
14	set program [file tail $argv0]
15	#set program bkgedit
16
17	if {[lindex $argv 1] == ""} {
18	set hst 1
19	} else {
20	set hst [lindex $argv 1]
21	}
22	if {[lindex $argv 2] == ""} {
23	set graph(legend) 1
24	} else {
25	set graph(legend) [lindex $argv 2]
26	}
27
28	set graph(backsub) 0
29
30	if {$tcl_platform(platform) == "windows"} {
31	set graph(printout) 1
32	set expgui(tcldump) tcldump.exe
33	} else {
34	set graph(printout) 0
35	set expgui(tcldump) tcldump
36	}
37
38	# default values
39	set graph(outname) out.ps
40	set graph(outcmd) lpr
41	set xunits {}
42	set yunits {}
43	set graph(chi2) 0
44	set graph(xunits) 0
45	set graph(yunits) 0
46	set graph(autoraise) 1
47	set graph(color_diff) blue
48	set graph(color_chi2) magenta
49	set graph(color_bkg) green
50	set graph(color_calc) red
51	set graph(color_obs) black
52	set graph(color_input) magenta
53	set graph(color_fit) blue
54	set expgui(debug) 0
55	catch {if $env(DEBUG) {set expgui(debug) 1}}
56	#set expgui(debug) 1
57	set expgui(font) 14
58	set expgui(lblfontsize) 15
59	set expgui(fadetime) 10
60	set expgui(hklbox) 1
61	set expgui(autotick) 0
62	set expgui(pixelregion) 5
63	# location for web pages, if not found locally
64	set expgui(website) www.ncnr.nist.gov/xtal/software/expgui
65	set peakinfo(obssym) scross
66	set peakinfo(obssize) 1.0
67	set peakinfo(inpsym) triangle
68	set peakinfo(inpsize) 1.0
69	# create a set of markers for each phase
70	for {set i 1} {$i < 10} {incr i} {
71	set peakinfo(flag$i) 0
72	set peakinfo(max$i) Inf
73	set peakinfo(min$i) -Inf
74	set peakinfo(dashes$i) 1
75	}
76
77	if [catch {package require BLT} errmsg] {
78	tk_dialog .err "BLT Error" "Error -- Unable to load the BLT package" \
79	error 0 Quit
80	destroy .
81	}
82	# handle Tcl/Tk v8+ where BLT is in a namespace
83	# use the command so that it is loaded
84	catch {blt::graph}
85	catch {
86	namespace import blt::graph
87	namespace import blt::vector
88	}
89	# old versions of blt don't report a version number
90	if [catch {set blt_version}] {set blt_version 0}
91	# option for coloring markers: note that GH keeps changing how to do this!
92	# also element -mapped => -show
93	if {$blt_version < 2.3 \|\| $blt_version >= 8.0} {
94	# version 8.0 is ~same as 2.3
95	set graph(MarkerColorOpt) -fg
96	# mapped is needed in 8.0, both are OK in 2.3
97	set graph(ElementShowOption) "-mapped 1"
98	set graph(ElementHideOption) "-mapped 0"
99	} elseif {$blt_version >= 2.4} {
100	set graph(MarkerColorOpt) -outline
101	set graph(ElementShowOption) "-hide 0"
102	set graph(ElementHideOption) "-hide 1"
103	} else {
104	set graph(MarkerColorOpt) -color
105	set graph(ElementShowOption) "-mapped 1"
106	set graph(ElementHideOption) "-mapped 0"
107	}
108
109	proc waitmsg {message} {
110	set w .wait
111	# kill any window/frame with this name
112	catch {destroy $w}
113	pack [frame $w]
114	frame $w.bot -relief raised -bd 1
115	pack $w.bot -side bottom -fill both
116	frame $w.top -relief raised -bd 1
117	pack $w.top -side top -fill both -expand 1
118	label $w.msg -justify left -text $message -wrap 3i
119	catch {$w.msg configure -font \
120	-Adobe-Times-Medium-R-Normal---180------*
121	}
122	pack $w.msg -in $w.top -side right -expand 1 -fill both -padx 3m -pady 3m
123	label $w.bitmap -bitmap info
124	pack $w.bitmap -in $w.top -side left -padx 3m -pady 3m
125	update
126	}
127
128	proc donewaitmsg {} {
129	catch {destroy .wait}
130	update
131	}
132
133	waitmsg "Loading histogram, Please wait"
134
135	#--------------------------------------------------------------
136	# define constants
137	array set peakinfo {
138	color1 magenta
139	color2 cyan
140	color3 yellow
141	color4 sienna
142	color5 orange
143	color6 DarkViolet
144	color7 HotPink
145	color8 salmon
146	color9 LimeGreen
147	}
148	set cycle -1
149	set modtime 0
150
151	#----------------------------------------------------------------
152	# where are we?
153	set expgui(script) [info script]
154	# translate links -- go six levels deep
155	foreach i {1 2 3 4 5 6} {
156	if {[file type $expgui(script)] == "link"} {
157	set link [file readlink $expgui(script)]
158	if { [file pathtype $link] == "absolute" } {
159	set expgui(script) $link
160	} {
161	set expgui(script) [file dirname $expgui(script)]/$link
162	}
163	} else {
164	break
165	}
166	}
167
168	# fixup relative paths
169	if {[file pathtype $expgui(script)] == "relative"} {
170	set expgui(script) [file join [pwd] $expgui(script)]
171	}
172	set expgui(scriptdir) [file dirname $expgui(script) ]
173	set expgui(gsasdir) [file dirname $expgui(scriptdir)]
174	set expgui(gsasexe) [file join $expgui(gsasdir) exe]
175	set expgui(docdir) [file join $expgui(scriptdir) doc]
176
177	# called by a trace on expgui(lblfontsize)
178	proc setfontsize {a b c} {
179	global expgui graph
180	catch {
181	font config lblfont -size [expr -$expgui(lblfontsize)]
182	# this forces a redraw of the plot by changing the title to itself
183	.g configure -title [.g cget -title]
184	}
185	}
186	# define a font used for labels
187	if {$tcl_version >= 8.0} {
188	font create lblfont -family Helvetica -size [expr -$expgui(lblfontsize)]
189	trace variable expgui(lblfontsize) w setfontsize
190	}
191
192	proc readdata {box} {
193	global expgui modtime expnam
194	if [catch {
195	set modtime [file mtime $expnam.EXP]
196	set loadtime [time {
197	if {$expgui(tcldump) == ""} {
198	set p HSTDMP
199	readdata_hst $box
200	} else {
201	set p TCLDUMP
202	readdata_tcl $box
203	}
204	}]
205	if $expgui(debug) {
206	tk_dialog .time "Timing info" \
207	"Histogram loading took $loadtime" "" 0 OK
208	}
209	} errmsg] {
210	if $expgui(debug) {
211	catch {console show}
212	error $errmsg
213	}
214	$box config -title "Read error"
215	MyMessageBox -parent . -title "$p Error" \
216	-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" \
217	-icon error -type Continue -default continue \
218	-helplink "expguierr.html TCLDUMPError"
219	update
220	}
221	$box element show [lsort -decreasing [$box element show]]
222	global program
223	if {$program == "bkgedit"} bkghstInit
224	}
225
226	proc readdata_hst {box} {
227	global expgui expnam reflns
228	global lasthst
229	global hst peakinfo xunits
230	$box config -title "(Histogram update in progress)"
231	update
232	# parse the output of a file
233	set lasthst $hst
234	###########################################################################
235	# set input [open histdump.inp w]
236	# puts $input "$hst"
237	# close $input
238	# set input [open "\| $expgui(gsasexe)/hstdump $expnam < histdump.inp" w+]
239	###########################################################################
240	# use histdmp for histogram info
241	set input [open histdump$hst.inp w]
242	puts $input "$expnam"
243	puts $input "L"
244	puts $input "$hst"
245	puts $input "0"
246	close $input
247	# use hstdmp without an experiment name so that output
248	# is not sent to the .LST file
249	set input [open "\| $expgui(gsasexe)/hstdmp < histdump$hst.inp" r]
250
251	# initalize arrays
252	set num -1
253	set xlist {}
254	set obslist {}
255	set calclist {}
256	set bcklist {}
257	set xunits {}
258	# define a list of reflection positions for each phase
259	for {set i 1} {$i < 10} {incr i} {
260	set reflns($i) {}
261	}
262	set i 0
263	while {[gets $input line] >= 0} {
264	incr i
265	# run update every 50th line
266	if {$i > 50} {set i 0; update}
267	if [scan $line %d num] {
268	if {$num > 0} {
269	set Ispec 0
270	set X -999
271	scan [string range $line 8 end] %e%e%e%e%e%e \
272	X Iobs Icalc Ispec fixB fitB
273	#puts $line
274	# eliminate excluded points
275	if {$Ispec > 0.0 && $X >= 0} {
276	lappend xlist $X
277	lappend obslist $Iobs
278	lappend calclist $Icalc
279	lappend bcklist [expr $fixB + $fitB]
280	}
281	# add peaks to peak lists
282	# puts "[string range $line 6 6]"
283	# is this 6 or 7; 6 on win & 7 on SGI
284	if [regexp {[1-9]} [string range $line 6 7] ph] {
285	lappend reflns($ph) $X
286	}
287	}
288	} else {
289	regexp {Time\|Theta\|keV} $line xunits
290	}
291	}
292	if {$xunits == "Theta"} {set xunits "2-Theta"}
293	close $input
294	catch {file delete histdump$hst.inp}
295	xvec set $xlist
296	obsvec set $obslist
297	calcvec set $calclist
298	bckvec set $bcklist
299	diffvec set [obsvec - calcvec]
300	global obsvec calcvec diffvec
301	set maxdiff [set diffvec(max)]
302	set cmin [set calcvec(min)]
303	set omin [set obsvec(min)]
304	set cmax [set calcvec(max)]
305	set omax [set obsvec(max)]
306	set expgui(min) [expr $omin < $cmin ? $omin : $cmin]
307	set expgui(max) [expr $omax > $cmax ? $omax : $cmax]
308	set ymin1 [expr $cmin - 1.1*$maxdiff]
309	set ymin2 [expr $omin - 1.1*$maxdiff]
310	if {$ymin1 < $ymin2} {
311	diffvec set [diffvec + $ymin1]
312	} {
313	diffvec set [diffvec + $ymin2]
314	}
315	plotdata
316	}
317
318	proc readdata_tcl {box} {
319	global expgui expnam reflns
320	global lasthst graph
321	global hst peakinfo xunits yunits
322	$box config -title "(Histogram update in progress)"
323	update
324	# parse the output of a file
325	set lasthst $hst
326	# use tcldump
327	set input [open histdump$hst.inp w]
328	puts $input "$hst"
329	# x units -- native
330	puts $input "$graph(xunits)"
331	# y units -- native
332	puts $input "$graph(yunits)"
333	# format (if implemented someday)
334	puts $input "0"
335	close $input
336	# initalize arrays
337	set X {}
338	set OBS {}
339	set CALC {}
340	set BKG {}
341	set WGT {}
342	global refhkllist refphaselist refpos
343	set refpos {}
344	set refhkllist {}
345	set refphaselist {}
346	for {set i 1} {$i < 10} {incr i} {
347	set reflns($i) {}
348	}
349	eval [exec $expgui(tcldump) $expnam < histdump$hst.inp]
350	catch {file delete histdump$hst.inp}
351	if {$X == ""} {
352	$box config -title "(Error reading Histogram $hst)"
353	foreach elem [$box element show] {
354	eval $box element config $elem $graph(ElementHideOption)
355	}
356	return
357	}
358	foreach elem [$box element names] {
359	eval $box element config $elem $graph(ElementShowOption)
360	}
361	xvec set $X
362	obsvec set $OBS
363	calcvec set $CALC
364	bckvec set $BKG
365	refposvec set $refpos
366	diffvec set [obsvec - calcvec]
367	if {$graph(chi2)} {
368	wifdvec set $WGT
369	wifdvec set [wifdvec * diffvec]
370	wifdvec set [wifdvec * diffvec]
371	# now do a running sum
372	set sum 0
373	set sumlist {}
374	foreach n [wifdvec range 0 end] {
375	set sum [expr $sum + $n]
376	lappend sumlist $sum
377	}
378	wifdvec set $sumlist
379	wifdvec set [wifdvec / [wifdvec length]]
380	}
381	if $graph(backsub) {
382	obsvec set [obsvec - bckvec]
383	calcvec set [calcvec - bckvec]
384	}
385	global obsvec calcvec diffvec
386	set maxdiff [set diffvec(max)]
387	set cmin [set calcvec(min)]
388	set omin [set obsvec(min)]
389	set cmax [set calcvec(max)]
390	set omax [set obsvec(max)]
391	set expgui(min) [expr $omin < $cmin ? $omin : $cmin]
392	set expgui(max) [expr $omax > $cmax ? $omax : $cmax]
393	set ymin1 [expr $cmin - 1.1*$maxdiff]
394	set ymin2 [expr $omin - 1.1*$maxdiff]
395	if {$ymin1 < $ymin2} {
396	diffvec set [diffvec + $ymin1]
397	} {
398	diffvec set [diffvec + $ymin2]
399	}
400
401	plotdata
402	}
403
404	proc lblhkl {plot x} {
405	global blt_version expgui tcl_platform tcl_version
406	global refhkllist refphaselist peakinfo refpos
407	# look for peaks within pixelregion pixels or the entire plot range
408	if {$x == "all"} {
409	foreach {xmin xmax} [$plot xaxis limits] {}
410	} else {
411	set xmin [$plot xaxis invtransform [expr $x - $expgui(pixelregion)]]
412	set xmax [$plot xaxis invtransform [expr $x + $expgui(pixelregion)]]
413	}
414	set peaknums [refposvec search $xmin $xmax]
415	set peaklist {}
416	# create a box, if needed
417	if {$expgui(hklbox)} {
418	catch {
419	toplevel .hkl
420	text .hkl.txt -width 30 -height 10 -wrap none \
421	-yscrollcommand ".hkl.yscroll set"
422	scrollbar .hkl.yscroll -command ".hkl.txt yview"
423	grid .hkl.txt -column 0 -row 1 -sticky nsew
424	grid .hkl.yscroll -column 1 -row 1 -sticky ns
425	grid columnconfigure .hkl 0 -weight 1
426	grid rowconfigure .hkl 1 -weight 1
427	wm title .hkl "Liveplot HKL Labels"
428	wm iconname .hkl HKL
429	.hkl.txt insert end "Phase\thkl\tPosition"
430	}
431	}
432	set xcen 0
433	set lbls 0
434	foreach peak $peaknums {
435	# put all hkls, all phases in the box
436	if {$expgui(hklbox)} {
437	catch {
438	.hkl.txt insert end "\n[lindex $refphaselist $peak]"
439	.hkl.txt insert end "\t[lindex $refhkllist $peak]"
440	.hkl.txt insert end "\t[lindex $refpos $peak]"
441	.hkl.txt see end
442	}
443	}
444	# label phases with tick marks
445	if [set peakinfo(flag[lindex $refphaselist $peak])] {
446	set pos [refposvec range $peak $peak]
447	if {$lbls <= 0} {
448	set xcen $pos
449	set peaklist [lindex $refhkllist $peak]
450	set lbls 1
451	} elseif {abs($xcen/$lbls-$pos) <= $expgui(pixelregion)} {
452	set xcen [expr $xcen + $pos]
453	lappend peaklist [lindex $refhkllist $peak]
454	incr lbls
455	} else {
456	puthkllbl $plot $peaklist $xcen $lbls
457	set xcen $pos
458	set peaklist [lindex $refhkllist $peak]
459	set lbls 1
460	}
461	}
462	}
463	puthkllbl $plot $peaklist $xcen $lbls
464	}
465
466	proc puthkllbl {plot peaklist xcen lbls} {
467	global blt_version tcl_platform tcl_version expgui
468	if {$peaklist == ""} return
469	set xcen [expr $xcen / $lbls]
470	# avoid bug in BLT 2.3 where Inf does not work for text markers
471	if {$blt_version == 2.3} {
472	set ycen [lindex [$plot yaxis limits] 1]
473	} else {
474	set ycen Inf
475	}
476	# older BLT versions can't rotate text in windows
477	if {$tcl_platform(platform) == "windows" && \
478	($blt_version <= 2.3 \|\| $blt_version == 8.0)} {
479	regsub -all { } $peaklist "\n" peaklist
480	set mark [$plot marker create text -coords "$xcen $ycen" \
481	-text $peaklist -anchor n -bg "" -name hkl$xcen]
482	} else {
483	set mark [$plot marker create text -coords "$xcen $ycen" \
484	-rotate 90 -text $peaklist -anchor n -bg "" -name hkl$xcen]
485	}
486	if {$tcl_version >= 8.0} {
487	$plot marker config hkl$xcen -font lblfont
488	}
489	if {$expgui(fadetime) > 0} {
490	catch {
491	after [expr $expgui(fadetime) * 1000 ] \
492	"catch \{ $plot marker delete $mark \}"
493	}
494	}
495	}
496
497	proc delallhkllbl {plot} {
498	catch {
499	eval $plot marker delete [$plot marker names hkl*]
500	}
501	}
502
503	proc plotdata {} {
504	global expnam hst peakinfo xunits yunits cycle reflns modtime
505	global lasthst graph expgui box
506
507	# is there a new histogram to load?
508	if {$hst != $lasthst} {
509	xvec set {}
510	xvec notify now
511	set cycle -1
512	set modtime 0
513	$box config -title "Please wait: loading histogram $hst"
514	update
515	return
516	}
517	$box config -title "$expnam cycle $cycle Hist $hst"
518	$box xaxis config -title $xunits
519	$box yaxis config -title $yunits
520	setlegend $box $graph(legend)
521	# reconfigure the data
522	$box element configure 3 \
523	-symbol $peakinfo(obssym) -color $graph(color_obs) \
524	-pixels [expr 0.125 * $peakinfo(obssize)]i
525	$box element config 0 -color $graph(color_chi2)
526	$box element config 1 -color $graph(color_bkg)
527	$box element config 2 -color $graph(color_calc)
528	$box element config 4 -color $graph(color_diff)
529	global program
530	if {$program == "bkgedit"} {
531	$box element config 12 -color $graph(color_input) \
532	-pixels [expr 0.125 * $peakinfo(inpsize)]i \
533	-symbol $peakinfo(inpsym)
534	$box element config 11 -color $graph(color_fit)
535	}
536	xvec notify now
537	obsvec notify now
538	calcvec notify now
539	bckvec notify now
540	diffvec notify now
541	wifdvec notify now
542	# now deal with peaks
543	for {set i 1} {$i < 10} {incr i} {
544	if {$expgui(autotick)} {
545	set div [expr ( $expgui(max) - $expgui(min) )/40.]
546	set ymin [expr $expgui(min) - ($i+1) * $div]
547	set ymax [expr $expgui(min) - $i * $div]
548	} else {
549	set ymin $peakinfo(min$i)
550	set ymax $peakinfo(max$i)
551	}
552	set j 0
553	if [set peakinfo(flag$i)] {
554	foreach X $reflns($i) {
555	incr j
556	catch {
557	$box marker create line -name peaks${i}_$j
558	}
559	$box marker config peaks${i}_$j -under 1 \
560	-coords "$X $ymin $X $ymax"
561	catch {
562	$box marker config peaks${i}_$j \
563	$graph(MarkerColorOpt) [list $peakinfo(color$i)]
564	if $peakinfo(dashes$i) {
565	$box marker config peaks${i}_$j -dashes "5 5"
566	}
567	}
568	}
569	catch {$box element create phase$i}
570	catch {
571	$box element config phase$i -color $peakinfo(color$i)
572	}
573	} else {
574	eval $box marker delete [$box marker names peaks${i}_*]
575	eval $box element delete [$box element names phase$i]
576	}
577	}
578	# force an update of the plot as BLT may not
579	$box config -title [$box cget -title]
580	update
581	}
582
583	proc setlegend {box legend} {
584	global blt_version
585	if {$blt_version >= 2.3 && $blt_version < 8.0} {
586	if $legend {
587	$box legend config -hide no
588	} else {
589	$box legend config -hide yes
590	}
591	} else {
592	if $legend {
593	$box legend config -mapped yes
594	} else {
595	$box legend config -mapped no
596	}
597	}
598	}
599
600	proc minioptionsbox {num} {
601	global blt_version tcl_platform peakinfo expgui
602	set bx .opt$num
603	catch {destroy $bx}
604	toplevel $bx
605	wm iconname $bx "Phase $num options"
606	wm title $bx "Phase $num options"
607
608	set i $num
609	pack [label $bx.0 -text "Phase $i reflns" ] -side top
610	pack [checkbutton $bx.1 -text "Show reflections" \
611	-variable peakinfo(flag$i)] -side top
612	# remove option that does not work
613	if {$blt_version != 8.0 \|\| $tcl_platform(platform) != "windows"} {
614	pack [checkbutton $bx.2 -text "Use dashed line" \
615	-variable peakinfo(dashes$i)] -side top
616	}
617	if !$expgui(autotick) {
618	pack [frame $bx.p$i -bd 2 -relief groove] -side top
619	# pack [checkbutton $bx.p$i.0 -text "Show phase $i reflns" \
620	# -variable peakinfo(flag$i)] -side left -anchor w
621	pack [label $bx.p$i.1 -text " Y min:"] -side left
622	pack [entry $bx.p$i.2 -textvariable peakinfo(min$i) -width 5] \
623	-side left
624	pack [label $bx.p$i.3 -text " Y max:"] -side left
625	pack [entry $bx.p$i.4 -textvariable peakinfo(max$i) -width 5] \
626	-side left
627	}
628	pack [frame $bx.c$i -bd 2 -relief groove] -side top
629
630	pack [label $bx.c$i.5 -text " color:"] -side left
631	pack [entry $bx.c$i.6 -textvariable peakinfo(color$i) -width 12] \
632	-side left
633	pack [button $bx.c$i.2 -bg $peakinfo(color$i) -state disabled] -side left
634	pack [button $bx.c$i.1 -text "Color\nmenu" \
635	-command "setcolor $i"] -side left
636	pack [frame $bx.b] -side top
637	#pack [button $bx.b.1 -command plotdata -text "Update Plot"] \
638	# -side left
639	pack [button $bx.b.4 -command "destroy $bx" -text Close ] -side right
640	}
641
642	proc setcolor {num} {
643	global peakinfo
644	set color [tk_chooseColor -initialcolor $peakinfo(color$num) -title "Choose color"]
645	if {$color == ""} return
646	set peakinfo(color$num) $color
647	}
648
649	proc makepostscriptout {} {
650	global graph box
651	if !$graph(printout) {
652	set out [open "\| $graph(outcmd) >& liveplot.msg" w]
653	catch {
654	puts $out [$box postscript output -landscape 1 \
655	-decorations no -height 7.i -width 9.5i]
656	close $out
657	} msg
658	catch {
659	set out [open liveplot.msg r]
660	if {$msg != ""} {append msg "\n"}
661	append msg [read $out]
662	close $out
663	catch {file delete liveplot.msg}
664	}
665	if {$msg != ""} {
666	tk_dialog .msg "file created" \
667	"Postscript file processed with command \
668	$graph(outcmd). Result: $msg" "" 0 OK
669	} else {
670	tk_dialog .msg "file created" \
671	"Postscript file processed with command \
672	$graph(outcmd)" "" 0 OK
673	}
674	} else {
675	$box postscript output $graph(outname) -landscape 1 \
676	-decorations no -height 7.i -width 9.5i
677	tk_dialog .msg "file created" \
678	"Postscript file $graph(outname) created" "" 0 OK
679	}
680	}
681
682	proc setprintopt {page} {
683	global graph
684	if $graph(printout) {
685	$page.4.1 config -fg black
686	$page.4.2 config -fg black -state normal
687	$page.6.1 config -fg #888
688	$page.6.2 config -fg #888 -state disabled
689	} else {
690	$page.4.1 config -fg #888
691	$page.4.2 config -fg #888 -state disabled
692	$page.6.1 config -fg black
693	$page.6.2 config -fg black -state normal
694	}
695	}
696
697	proc setpostscriptout {} {
698	global graph tcl_platform
699	set box .out
700	catch {destroy $box}
701	toplevel $box
702	focus $box
703	wm title $box "Set PS options"
704	pack [frame $box.4] -side top -anchor w -fill x
705	pack [checkbutton $box.4.a -text "Write PostScript files" \
706	-variable graph(printout) -offvalue 0 -onvalue 1 \
707	-command "setprintopt $box"] -side left -anchor w
708	pack [entry $box.4.2 -textvariable graph(outname)] -side right -anchor w
709	pack [label $box.4.1 -text "PostScript file name:"] -side right -anchor w
710	pack [frame $box.6] -side top -anchor w -fill x
711	pack [checkbutton $box.6.a -text "Print PostScript files" \
712	-variable graph(printout) -offvalue 1 -onvalue 0 \
713	-command "setprintopt $box" ] -side left -anchor w
714	pack [entry $box.6.2 -textvariable graph(outcmd)] -side right -anchor w
715	pack [label $box.6.1 -text "Command to print files:"] -side right -anchor w
716
717	pack [button $box.a -text "Close" -command "destroy $box"] -side top
718	if {$tcl_platform(platform) == "windows"} {
719	set graph(printout) 1
720	$box.4.a config -state disabled
721	$box.6.a config -fg #888 -state disabled
722	}
723	setprintopt $box
724	}
725
726	proc setlblopts {} {
727	global expgui tcl_platform tcl_version
728	set box .out
729	catch {destroy $box}
730	toplevel $box
731	focus $box
732	wm title $box "Set hkl options"
733	pack [frame $box.c] -side top -anchor w
734	pack [label $box.c.l -text "HKL label\nerase time:"] -side left
735	pack [entry $box.c.e -textvariable expgui(fadetime) -width 8] \
736	-side left
737	pack [label $box.c.l1 -text seconds] -side left
738	pack [frame $box.d] -side top -anchor w
739	pack [label $box.d.l -text "HKL label size:"] -side left
740	pack [entry $box.d.e -textvariable expgui(lblfontsize) -width 4] \
741	-side left
742	pack [label $box.d.l1 -text pixels] -side left
743	# old versions if tcl/tk don't support the font command
744	if {$tcl_version < 8.0} {
745	$box.d.l config -fg #888
746	$box.d.e config -fg #888 -state disabled
747	$box.d.l1 config -fg #888
748	}
749	pack [frame $box.f] -side top -anchor w
750	pack [label $box.f.l -text "HKL search region:"] -side left
751	pack [entry $box.f.e -textvariable expgui(pixelregion) -width 3] \
752	-side left
753	pack [label $box.f.l1 -text pixels] -side left
754	pack [frame $box.e] -side top -anchor w
755	pack [checkbutton $box.e.b -text "Separate window for HKL labels"\
756	-variable expgui(hklbox)] -side left
757	pack [button $box.a -text "Close" -command "destroy $box"] -side top
758	}
759
760	proc getsymopts {"sym obs"} {
761	global expgui peakinfo
762	set box .out
763	catch {destroy $box}
764	toplevel $box
765	focus $box
766	wm title .out "set $sym symbol"
767	pack [frame $box.d] -side left -anchor n
768	pack [label $box.d.t -text "Symbol type"] -side top
769	set expgui(sym) $peakinfo(${sym}sym)
770	set expgui(size) $peakinfo(${sym}size)
771	foreach symbol {square circle diamond triangle plus cross \
772	splus scross} \
773	symbol_name {square circle diamond triangle plus cross \
774	thin-plus thin-cross} {
775	pack [radiobutton $box.d.$symbol \
776	-text $symbol_name -variable expgui(sym) \
777	-value $symbol] -side top -anchor w
778	}
779	pack [frame $box.e] -side left -anchor n -fill y
780	pack [label $box.e.l -text "Symbol Size"] -side top
781	pack [scale $box.e.s -variable expgui(size) \
782	-from .1 -to 3 -resolution 0.05] -side top
783	pack [frame $box.a] -side bottom
784	pack [button $box.a.1 -text "Apply" -command "setsymopts $sym"] -side left
785	pack [button $box.a.2 -text "Close" -command "destroy $box"] -side left
786	}
787	proc setsymopts {sym} {
788	global peakinfo expgui
789	if {$peakinfo(${sym}sym) != $expgui(sym)} {set peakinfo(${sym}sym) $expgui(sym)}
790	if {$peakinfo(${sym}size) != $expgui(size)} {set peakinfo(${sym}size) $expgui(size)}
791	}
792
793	# save some of the global options in ~/.gsas_config
794	proc SaveOptions {} {
795	global graph expgui peakinfo
796	set fp [open [file join ~ .gsas_config] a]
797	foreach v {printout legend outname outcmd autoraise chi2} {
798	puts $fp "set graph($v) $graph($v)"
799	}
800	foreach v {diff chi2 bkg calc obs input fit} {
801	puts $fp "set graph(color_$v) $graph(color_$v)"
802	}
803	foreach v {font lblfontsize fadetime hklbox pixelregion autotick} {
804	puts $fp "set expgui($v) $expgui($v)"
805	}
806	foreach v {obssym obssize inpsym inpsize} {
807	puts $fp "set peakinfo($v) $peakinfo($v)"
808	}
809	close $fp
810	}
811
812	proc aboutliveplot {} {
813	global Revision
814	tk_dialog .warn About "
815	GSAS\n\
816	A. C. Larson and\n R. B. Von Dreele,\n LANSCE, Los Alamos\n\n\
817	LIVEPLOT\nB. Toby, NIST\nNot subject to copyright\n\n\
818	$Revision\n\
819	" {} 0 OK
820	}
821
822	proc getcycle {} {
823	global expnam
824	set cycle -1
825	catch {
826	set fp [open $expnam.EXP r]
827	set text [read $fp]
828	close $fp
829	regexp {GNLS RUN.Total cycles run ([0-9]*) } $text x cycle
830	}
831	return $cycle
832	}
833
834	proc updateifnew {} {
835	global cycle modtime expnam env tcl_platform graph
836	# has the .EXP file been changed?
837	if {[file mtime $expnam.EXP] != $modtime} {
838	# are we in windows and are "locked?" If not, OK to update
839	if {$tcl_platform(platform) == "windows" && [file exists expgui.lck]} {
840	.g config -title "(Experiment directory locked)"
841	} else {
842	set modtime [file mtime $expnam.EXP]
843	set newcycle [getcycle]
844	if {$newcycle != $cycle} {
845	set cycle $newcycle
846	readdata .g
847	}
848	if {$tcl_platform(platform) == "windows" && $graph(autoraise)} {
849	# raise does not seem to be global in Windows,
850	# but this works in Win-95
851	# nothing seems to work in Win-NT
852	wm withdraw .
853	wm deiconify .
854	} elseif {$graph(autoraise)} {
855	raise .
856	}
857	}
858	}
859	# check again in a second
860	after 1000 updateifnew
861	}
862
863	proc plotdataupdate {array element action} {
864	global box peakinfo reflns graph
865	# parse the element
866	regexp {([a-z])([0-9])} $element junk var num
867	if {$var == "color"} {
868	if {$peakinfo($element) == ""} return
869	if [catch {
870	.opt$num.c$num.2 config -bg $peakinfo($element)
871	} ] return
872	set i $num
873	set j 0
874	if [set peakinfo(flag$i)] {
875	catch {
876	$box element config phase$i -color $peakinfo(color$i)
877	}
878	foreach X $reflns($i) {
879	incr j
880	catch {
881	$box marker config peaks${i}_$j \
882	$graph(MarkerColorOpt) [list $peakinfo(color$i)]
883	}
884	}
885	}
886	return
887	}
888	waitmsg {Updating}
889	plotdata
890	donewaitmsg
891	}
892	proc ShowCumulativeChi2 {} {
893	global graph box
894	if $graph(chi2) {
895	eval $box y2axis config $graph(ElementShowOption)
896	eval $box element config 0 $graph(ElementShowOption) -label "Chi2"
897	set cycle [getcycle]
898	readdata .g
899	} else {
900	eval $box element config 0 $graph(ElementHideOption)
901	eval $box y2axis config $graph(ElementHideOption)
902	$box element config 0 -label ""
903	}
904	}
905	# evaluate the Chebyshev polynomial with coefficients A at point x
906	# coordinates are rescaled from $xmin=-1 to $xmax=1
907	proc chebeval {A x xmin xmax} {
908	set xs [expr {-1 + 2 * (1.$x - $xmin) / (1.$xmax - 1.*$xmin)}]
909	set Tpp 0
910	set Tp 0
911	set total 0
912	foreach a $A {
913	if {$Tpp == $Tp && $Tp == 0} {
914	set T 1
915	} elseif {$Tpp == 0} {
916	set T $xs
917	} else {
918	set T [expr {2. * $xs * $Tp - $Tpp}]
919	}
920	set total [expr {$total + $a * $T}]
921	set Tpp $Tp
922	set Tp $T
923	}
924	return $total
925	}
926
927	# determine a very approximate set of Chebyshev coefficients of order n
928	# to compute Y from X (fast but not very good)
929	proc chebgen {X Y xmin xmax n} {
930	if {[llength $X] != [llength $Y]} return
931	set xnorm [expr {2. / ($xmax - $xmin)}]
932	set pi [expr {2*asin(1)}]
933	set a(0) 0.
934	for {set i 1} {$i < $n} {incr i} {set a($i) 0.}
935	foreach x1 $X x2 [lrange $X 1 end] y1 $Y y2 [lrange $Y 1 end] {
936	if {$x2 == ""} break
937	set xs1 [expr {-1 + ($x1 - $xmin) * $xnorm}]
938	set th1 [expr {acos(-1 + ($x1 - $xmin) * $xnorm)}]
939	set xs2 [expr {-1 + ($x2 - $xmin) * $xnorm}]
940	set th2 [expr {acos(-1 + ($x2 - $xmin) * $xnorm)}]
941	set thbar [expr {($th1 + $th2)/2.}]
942	set dth [expr {$th1 - $th2}]
943	set xsbar [expr {cos($thbar)}]
944	# skip duplicate points
945	if {$xs2 == $xs1} continue
946	set ybar [expr {($xsbar - $xs1) / ($xs2 - $xs1) * ($y2 - $y1) + $y1}]
947	# seems to work better starting with just 2 terms
948	# for {set i 0} {$i < $n} {incr i}
949	for {set i 0} {$i < 2} {incr i} {
950	set a($i) [expr {$a($i) + $ybar * cos($i$thbar) $dth}]
951	}
952	}
953	set A [expr {$a(0) / $pi}]
954	for {set i 1} {$i < $n} {incr i} {
955	lappend A [expr {2 * $a($i) / $pi}]
956	}
957	return $A
958	}
959
960	# disable the improve fit button
961	proc bkgResetFit {} {
962	.bkg.f.fit2 config -state disabled
963	}
964
965	# enable the improve fit button, if appropriate
966	proc bkgMoreFit {} {
967	global cheblist
968	if {[llength $cheblist] < 2} {bkgResetFit;return}
969	.bkg.f.fit2 config -state normal
970	}
971
972	# perform a Gauss-Newton fit to optimize Chebyshev coefficients A
973	proc chebGN {X Y S A xmin xmax "damp 0.75"} {
974	# Gauss-Newton
975	if {[llength $X] != [llength $Y]} return
976	set xnorm [expr {2. / ($xmax - $xmin)}]
977	# denominator
978	set sum2 0.
979	foreach x $X s $S {
980	set xs [expr {-1 + (1.$x - $xmin) $xnorm}]
981	set Tpp 0
982	set Tp 0
983	foreach a1 $A {
984	if {$Tpp == $Tp && $Tp == 0} {
985	set T 1
986	} elseif {$Tpp == 0} {
987	set T $xs
988	} else {
989	set T [expr {2. * $xs * $Tp - $Tpp}]
990	}
991	set sum2 [expr {$sum2 + $T /($s*$s)}]
992	set Tpp $Tp
993	set Tp $T
994	}
995	}
996	# Evaluate Ycalc & sum(delta2)
997	set sumd2 0.
998	foreach x $X y $Y {
999	# set xs [expr {-1 + (1.$x - $xmin) $xnorm}]
1000	lappend Ycalc [set yc [chebeval $A $x $xmin $xmax]]
1001	set sumd2 [expr {$sumd2 + ($y - $yc)*($y - $yc)}]
1002	}
1003	set k -1
1004	foreach a $A {incr k; set sum($k) 0}
1005	foreach x $X y $Y yc $Ycalc s $S {
1006	set xs [expr {-1 + (1.$x - $xmin) $xnorm}]
1007	set Tpp 0
1008	set Tp 0
1009	set k -1
1010	foreach a $A {
1011	incr k
1012	if {$Tpp == $Tp && $Tp == 0} {
1013	set T 1
1014	} elseif {$Tpp == 0} {
1015	set T $xs
1016	} else {
1017	set T [expr {2. * $xs * $Tp - $Tpp}]
1018	}
1019	set sum($k) [expr {$sum($k) + ($T * ($yc - $y))/($s*$s)}]
1020	set Tpp $Tp
1021	set Tp $T
1022	}
1023	}
1024	set sumd2r $sumd2
1025	set d $damp
1026	# compute new cheb terms
1027	while {$d > $damp/32} {
1028	set k -1
1029	set Anew {}
1030	foreach a $A {
1031	incr k
1032	lappend Anew [expr {$a - $d*($sum($k) / $sum2)}]
1033	}
1034	# Evaluate new Ycalc & sum(delta2)
1035	set sumd2r 0.
1036	foreach x $X y $Y {
1037	# set xs [expr {-1 + (1.$x - $xmin) $xnorm}]
1038	set yc [chebeval $Anew $x $xmin $xmax]
1039	set sumd2r [expr {$sumd2r + ($y - $yc)*($y - $yc)}]
1040	}
1041	# are these shifts an improvement?
1042	if {$sumd2r < $sumd2} {
1043	# are we converged?
1044	if {[expr {($sumd2-$sumd2r)/$sumd2}] < 0.0001} {return ""}
1045	return $Anew
1046	}
1047	set d [expr {$d/2.}]
1048	}
1049	return ""
1050	}
1051
1052	# change the binding of the mouse, based on the selected mode
1053	proc bkgEditMode {b} {
1054	global zoomcommand box
1055	# get binding
1056	set bindtag $box
1057	catch {
1058	if {[bind bltZoomGraph] != ""} {
1059	set bindtag bltZoomGraph
1060	}
1061	}
1062	# save the zoom command
1063	if [catch {set zoomcommand}] {
1064	set zoomcommand [bind $bindtag <1>]
1065	.bkg.f.fit1 config -state disabled
1066	.bkg.f.fit2 config -state disabled
1067	.bkg.f.terms config -state disabled
1068	}
1069	foreach c {1 2 3} {
1070	if {$c == $b} {
1071	.bkg.l.b$c config -relief sunken
1072	} else {
1073	.bkg.l.b$c config -relief raised
1074	}
1075	}
1076	# reset previous mode; if in the middle
1077	if {[string trim [bind $box <Motion>]] != ""} {
1078	blt::ResetZoom $box
1079	}
1080	if {$b == 2} {
1081	bind $bindtag <1> "bkgAddPoint %x %y"
1082	.g config -cursor arrow
1083	} elseif {$b == 3} {
1084	bind $bindtag <1> "bkgDelPoint %x %y"
1085	.g config -cursor circle
1086	} else {
1087	bind $bindtag <1> $zoomcommand
1088	.g config -cursor crosshair
1089	}
1090	}
1091
1092	# plot the background points
1093	proc bkgPointPlot {} {
1094	global bkglist termmenu chebterms expnam hst tmin tmax
1095	set l {}
1096	set fp [open $expnam.bkg$hst w]
1097	puts $fp "y p h e $hst b ! fixed background points for use in BKGEDIT"
1098	foreach p $bkglist {
1099	puts $fp "i\t$p\t0.0"
1100	append l " $p"
1101	}
1102	if {[llength $bkglist] > 0} {
1103	puts $fp "i\t[expr $tmin*0.99] [lindex [lindex $bkglist 0] 1]\t0.0"
1104	puts $fp "i\t[expr $tmax*1.01] [lindex [lindex $bkglist end] 1]\t0.0"
1105	}
1106	close $fp
1107	.g element config 12 -data $l
1108	if {[set l [llength $bkglist]] > 3} {
1109	.bkg.f.fit1 config -state normal
1110	.bkg.f.terms config -state normal
1111	$termmenu delete 0 end
1112	set imax {}
1113	for {set i 2} {$i <= $l/1.5} {incr i 2} {
1114	$termmenu insert end radiobutton -label $i \
1115	-variable chebterms -command {bkgMoreFit}
1116	set imax $i
1117	}
1118	if {$imax < $chebterms} {set chebterms $imax}
1119	} else {
1120	.bkg.f.fit1 config -state disabled
1121	.bkg.f.fit2 config -state disabled
1122	.bkg.f.terms config -state disabled
1123	set chebterms 2
1124	}
1125	}
1126
1127	# add a bkg point at screen coordinates x,y
1128	proc bkgAddPoint {x y} {
1129	global bkglist tmin tmax
1130	set xy [.g invtransform $x $y]
1131	set x [lindex $xy 0]
1132	if {$x < $tmin} {set x $tmin}
1133	if {$x > $tmax} {set x $tmax}
1134	lappend bkglist [list $x [lindex $xy 1]]
1135	set bkglist [lsort -real -index 0 $bkglist]
1136	bkgMoreFit
1137	bkgFillPoints
1138	bkgPointPlot
1139	}
1140
1141	# delete the bkg point closest to screen coordinates x,y
1142	proc bkgDelPoint {x y} {
1143	global bkglist
1144	set closest {}
1145	set dist2 {}
1146	set i -1
1147	foreach p $bkglist {
1148	incr i
1149	set sxy [eval .g transform $p]
1150	if {$closest == ""} {
1151	set closest $i
1152	set dist2 0
1153	foreach v1 $sxy v2 "$x $y" {
1154	set dist2 [expr {$dist2 + ($v1 - $v2)*($v1 - $v2)}]
1155	}
1156	} else {
1157	set d2 0
1158	foreach v1 $sxy v2 "$x $y" {
1159	set d2 [expr {$d2 + ($v1 - $v2)*($v1 - $v2)}]
1160	}
1161	if {$d2 < $dist2} {
1162	set closest $i
1163	set dist2 $d2
1164	}
1165	}
1166	}
1167	set bkglist [lreplace $bkglist $closest $closest]
1168	bkgMoreFit
1169	bkgPointPlot
1170	bkgFillPoints
1171	}
1172
1173	# initialize the background plot
1174	proc bkghstInit {} {
1175	global bkglist tmin tmax hst expnam cheblist chebterms
1176	set tmin [histinfo $hst tmin]
1177	set tmax [histinfo $hst tmax]
1178	if {[catch {expr $tmin}] \|\| [catch {expr $tmax}]} {
1179	tk_dialog .err "MIN/MAX Error" "Error -- Unable read tmin or tmax (has POWPREF been run?" \
1180	error 0 Quit
1181	destroy .
1182	}
1183
1184	set bkglist {}
1185	if [file exists $expnam.bkg$hst] {
1186	catch {
1187	set fp [open $expnam.bkg$hst r]
1188	gets $fp line
1189	while {[gets $fp line]>=0} {
1190	set x [lindex $line 1]
1191	set y [lindex $line 2]
1192	if {$x >= $tmin && $x <= $tmax} {
1193	lappend bkglist [list $x $y]
1194	}
1195	}
1196	}
1197	close $fp
1198	}
1199
1200	bkgEditMode 1
1201	bkgPointPlot
1202	bkgFillPoints
1203	set cheblist ""
1204	bkgResetFit
1205	BkgFillCheb
1206	set chebterms 2
1207	}
1208
1209	# fit a Chebyshev polynomial to the selected background points
1210	proc bkgFit {termlist button} {
1211	global bkglist chebterms cheblist
1212	$button config -relief sunken
1213	update
1214	foreach p $bkglist {
1215	lappend S 1.
1216	foreach v $p var {X Y} {
1217	lappend $var $v
1218	}
1219	}
1220	global tmin tmax
1221	if {[llength $termlist] < 2} {
1222	# get a starting point
1223	set termlist [chebgen $X $Y $tmin $tmax $chebterms]
1224	# plot it
1225	set calcb {}
1226	foreach x [xvec range 0 end] {
1227	lappend calcb [chebeval $termlist $x $tmin $tmax]
1228	}
1229	.g element configure 11 -xdata xvec -ydata $calcb
1230	update
1231	} elseif {[llength $termlist] < $chebterms} {
1232	while {[llength $termlist] < $chebterms} {
1233	lappend termlist 0.
1234	}
1235	} elseif {[llength $termlist] > $chebterms} {
1236	set termlist [lrange $termlist 0 [expr $chebterms -1]]
1237	}
1238	# iterate
1239	for {set i 1} {$i < 20} {incr i} {
1240	set termlist1 [chebGN $X $Y $S $termlist $tmin $tmax]
1241	# have we converged?
1242	if {$termlist1 == ""} {
1243	bkgResetFit
1244	set cheblist $termlist
1245	BkgFillCheb
1246	bkgFillPoints
1247	$button config -relief raised
1248	return
1249	}
1250	set termlist $termlist1
1251	set calcb {}
1252	foreach x [xvec range 0 end] {
1253	lappend calcb [chebeval $termlist $x $tmin $tmax]
1254	}
1255	.g element configure 11 -xdata xvec -ydata $calcb
1256	update
1257	}
1258	set cheblist $termlist
1259	BkgFillCheb
1260	bkgFillPoints
1261	bkgMoreFit
1262	$button config -relief raised
1263	}
1264
1265	# put the Chebyshev coefficients into edit widgets
1266	proc BkgFillCheb {} {
1267	global cheblist
1268	global chebedit
1269	catch {destroy .bkg.canvas.fr}
1270	set top [frame .bkg.canvas.fr]
1271	.bkg.canvas create window 0 0 -anchor nw -window $top
1272	# delete trace on chebedit
1273	foreach v [ trace vinfo chebedit] {
1274	eval trace vdelete chebedit $v
1275	}
1276	if {[llength $cheblist] == 0} {
1277	grid [label $top.0 -text "(no terms defined)"] -col 1 -row 1
1278	.bkg.cw config -state disabled
1279	} else {
1280	set i -1
1281	.bkg.cw config -state normal
1282	foreach c $cheblist {
1283	incr i
1284	grid [frame $top.$i -relief groove -bd 3] -col $i -row 1
1285	grid [label $top.$i.l -text "[expr 1+$i]"] -col 1 -row 1
1286	grid [entry $top.$i.e -textvariable chebedit($i) -width 13] \
1287	-col 2 -row 1
1288	set chebedit($i) $c
1289	}
1290	trace variable chebedit w "BkgRecalcCheb $top"
1291	}
1292	update idletasks
1293	set sizes [grid bbox $top]
1294	.bkg.canvas config -scrollregion $sizes -height [lindex $sizes 3]
1295	}
1296
1297	# respond to edits made to Chebyshev terms
1298	proc BkgRecalcCheb {top var i mode} {
1299	global chebedit cheblist
1300	if [catch {expr $chebedit($i)}] {
1301	$top.$i.e config -fg red
1302	} else {
1303	$top.$i.e config -fg black
1304	set cheblist [lreplace $cheblist $i $i $chebedit($i)]
1305	global tmin tmax
1306	# plot it
1307	set calcb {}
1308	foreach x [xvec range 0 end] {
1309	lappend calcb [chebeval $cheblist $x $tmin $tmax]
1310	}
1311	.g element configure 11 -xdata xvec -ydata $calcb
1312	update
1313	bkgMoreFit
1314	}
1315	}
1316
1317	# put the bkg points into edit widgets
1318	proc bkgFillPoints {} {
1319	global bkglist tmin tmax bkgedit
1320	# delete trace on bkgedit
1321	foreach v [ trace vinfo bkgedit] {
1322	eval trace vdelete bkgedit $v
1323	}
1324	catch {destroy .bkg.bc.fr}
1325	set top [frame .bkg.bc.fr]
1326	.bkg.bc create window 0 0 -anchor nw -window $top
1327	if {[llength $bkglist] == 0} {
1328	grid [label $top.0 -text "(no points defined)"] -col 1 -row 1
1329	} else {
1330	set i -1
1331	foreach p $bkglist {
1332	incr i
1333	grid [frame $top.$i -relief groove -bd 3] -col $i -row 1
1334	grid [label $top.$i.l -text "[expr 1+$i]"] -col 1 -rowspan 2 -row 1
1335	grid [entry $top.$i.ex -textvariable bkgedit(x$i) -width 13] \
1336	-col 2 -row 1
1337	grid [entry $top.$i.ey -textvariable bkgedit(y$i) -width 13] \
1338	-col 2 -row 2
1339	foreach val $p var {x y} {
1340	set bkgedit(${var}$i) $val
1341	}
1342	}
1343	trace variable bkgedit w "BkgRecalcBkg $top"
1344	}
1345	update idletasks
1346	set sizes [grid bbox $top]
1347	.bkg.bc config -scrollregion $sizes -height [lindex $sizes 3]
1348	}
1349
1350	# respond to edits made to bkg points
1351	proc BkgRecalcBkg {top var i mode} {
1352	global bkgedit bkglist tmin tmax
1353	regexp {(.)([0-9]*)} $i junk var num
1354	if [catch {expr $bkgedit($i)}] {
1355	$top.$num.e$var config -fg red
1356	} else {
1357	$top.$num.e$var config -fg black
1358	set p [lindex $bkglist $num]
1359	if {$var == "x"} {
1360	set x $bkgedit($i)
1361	if {$x < $tmin} {set x $tmin}
1362	if {$x > $tmax} {set x $tmax}
1363	set bkglist [lreplace $bkglist $num $num \
1364	[list $x [lindex $p 1]]]
1365	} else {
1366	set bkglist [lreplace $bkglist $num $num \
1367	[list [lindex $p 0] $bkgedit($i)]]
1368	}
1369	}
1370	bkgPointPlot
1371	}
1372
1373	# save the Chebyshev terms in the .EXP file
1374	proc bkgChebSave {} {
1375	global hst cheblist expgui Revision expmap expnam
1376	histinfo $hst backtype set 1
1377	histinfo $hst backterms set [llength $cheblist]
1378	set num 0
1379	foreach v $cheblist {
1380	set var "bterm[incr num]"
1381	histinfo $hst $var set $v
1382	}
1383	histinfo $hst bref set 0
1384	# add a history record
1385	exphistory add " BKGEDIT [lindex $Revision 1] [lindex $expmap(Revision) 1] -- [clock format [clock seconds]]"
1386	# now save the file
1387	expwrite $expnam.EXP
1388	}
1389
1390	#-------------------------------------------------------------------------
1391	# manual zoom option
1392	proc BLTmanualZoom {} {
1393	global graph
1394	catch {toplevel .zoom}
1395	eval destroy [grid slaves .zoom]
1396	raise .zoom
1397	wm title .zoom {Manual Scaling}
1398	grid [label .zoom.l1 -text minimum] -row 1 -column 2
1399	grid [label .zoom.l2 -text maximum] -row 1 -column 3
1400	grid [label .zoom.l3 -text x] -row 2 -column 1
1401	grid [label .zoom.l4 -text y] -row 3 -column 1
1402	grid [entry .zoom.xmin -textvariable graph(xmin) -width 10] -row 2 -column 2
1403	grid [entry .zoom.xmax -textvariable graph(xmax) -width 10] -row 2 -column 3
1404	grid [entry .zoom.ymin -textvariable graph(ymin) -width 10] -row 3 -column 2
1405	grid [entry .zoom.ymax -textvariable graph(ymax) -width 10] -row 3 -column 3
1406	grid [frame .zoom.b] -row 4 -column 1 -columnspan 3
1407	grid [button .zoom.b.1 -text "Set Scaling" \
1408	-command "SetManualZoom set"] -row 4 -column 1 -columnspan 2
1409	grid [button .zoom.b.2 -text Reset \
1410	-command "SetManualZoom clear"] -row 4 -column 3
1411	grid [button .zoom.b.3 -text Close -command "destroy .zoom"] -row 4 -column 4
1412	grid rowconfigure .zoom 1 -weight 1 -pad 5
1413	grid rowconfigure .zoom 2 -weight 1 -pad 5
1414	grid rowconfigure .zoom 3 -weight 1 -pad 5
1415	grid rowconfigure .zoom 4 -weight 0 -pad 5
1416	grid columnconfigure .zoom 1 -weight 1 -pad 20
1417	grid columnconfigure .zoom 1 -weight 1
1418	grid columnconfigure .zoom 3 -weight 1 -pad 10
1419	foreach item {min min max max} \
1420	format {3 2 3 2} \
1421	axis {x y x y} {
1422	set val [$graph(blt) ${axis}axis cget -${item}]
1423	set graph(${axis}${item}) {(auto)}
1424	catch {set graph(${axis}${item}) [format %.${format}f $val]}
1425	}
1426	}
1427
1428	proc SetManualZoom {mode} {
1429	global graph
1430	if {$mode == "clear"} {
1431	foreach item {xmin ymin xmax ymax} {
1432	set graph($item) {(auto)}
1433	}
1434	}
1435	foreach item {xmin ymin xmax ymax} {
1436	set $item {}
1437	catch {set $item [expr $graph($item)]}
1438	}
1439	# reset the zoomstack
1440	catch {Blt_ZoomStack $graph(blt)}
1441	catch {$graph(blt) xaxis config -min $xmin -max $xmax}
1442	catch {$graph(blt) yaxis config -min $ymin -max $ymax}
1443	}
1444
1445	source [file join $expgui(scriptdir) gsascmds.tcl]
1446	source [file join $expgui(scriptdir) readexp.tcl]
1447	source [file join $expgui(scriptdir) opts.tcl]
1448
1449	# override options with locally defined values
1450	if [file exists [file join $expgui(scriptdir) localconfig]] {
1451	source [file join $expgui(scriptdir) localconfig]
1452	}
1453	if [file exists [file join ~ .gsas_config]] {
1454	source [file join ~ .gsas_config]
1455	}
1456	SetTkDefaultOptions $expgui(font)
1457
1458	if [file executable [file join $expgui(gsasexe) $expgui(tcldump)]] {
1459	set expgui(tcldump) [file join $expgui(gsasexe) $expgui(tcldump)]
1460	# puts "got tcldump"
1461	} else {
1462	set expgui(tcldump) {}
1463	# puts "no tcldump"
1464	}
1465
1466	# vectors
1467	foreach vec {xvec obsvec calcvec bckvec diffvec refposvec wifdvec} {
1468	vector $vec
1469	$vec notify never
1470	}
1471	# create the graph
1472	if [catch {
1473	set box [graph .g -plotbackground white]
1474	} errmsg] {
1475	tk_dialog .err "BLT Error" \
1476	"BLT Setup Error: could not create a graph (msg: $errmsg). \
1477	There is a problem with the setup of BLT on your system.
1478	See the expgui.html file for more info." \
1479	error 0 "Quit"
1480	exit
1481	}
1482	if [catch {
1483	Blt_ZoomStack $box
1484	} errmsg] {
1485	tk_dialog .err "BLT Error" \
1486	"BLT Setup Error: could not access a Blt_ routine (msg: $errmsg). \
1487	The pkgIndex.tcl is probably not loading bltGraph.tcl.
1488	See the expgui.html file for more info." \
1489	error 0 "Limp ahead"
1490	}
1491	# modify zoom so that y2axis is not zoomed in for blt2.4u+
1492	catch {
1493	regsub -all y2axis [info body blt::PushZoom] " " b1
1494	proc blt::PushZoom {graph} $b1
1495	}
1496
1497	$box element create 0 -xdata xvec -ydata wifdvec -color $graph(color_chi2) \
1498	-line 3 -symbol none -label "Chi2" -mapy y2
1499	$box element create 1 -label bckgr -symbol none
1500	$box element config 1 -xdata xvec -ydata bckvec -color $graph(color_bkg)
1501	$box element create 3 -color $graph(color_obs) -linewidth 0 -label Obs \
1502	-symbol $peakinfo(obssym) \
1503	-pixels [expr 0.125 * $peakinfo(obssize)]i
1504	$box element create 2 -label Calc -color $graph(color_calc) -symbol none
1505	$box element create 4 -label diff -color $graph(color_diff) -symbol none
1506
1507	if {$program == "liveplot"} {
1508	$box y2axis config -min 0 -title {Cumulative Chi Squared}
1509	} elseif {$program == "bkgedit"} {
1510	eval $box element config 0 $graph(ElementHideOption)
1511	eval $box y2axis config $graph(ElementHideOption)
1512	$box element config 0 -label ""
1513	eval $box element config 1 $graph(ElementHideOption)
1514	$box element config 1 -label ""
1515	eval $box element config 4 $graph(ElementHideOption)
1516	$box element config 4 -label ""
1517	$box element create 11
1518	$box element create 12
1519	$box element configure 12 -color $graph(color_input) \
1520	-pixels [expr 0.125 * $peakinfo(inpsize)]i \
1521	-line 0 -symbol $peakinfo(inpsym) -label "bkg pts"
1522	$box element configure 11 -color $graph(color_fit) \
1523	-symbol none -label "Cheb fit" -dashes 5 -line 2
1524	$box element show "3 2 11 12"
1525	}
1526	$box element config 3 -xdata xvec -ydata obsvec
1527	$box element config 2 -xdata xvec -ydata calcvec
1528	$box element config 4 -xdata xvec -ydata diffvec
1529
1530	if {$expgui(tcldump) != ""} {
1531	bind . <Key-h> "lblhkl $box %x"
1532	bind . <Key-H> "lblhkl $box %x"
1533	bind . <Key-a> "lblhkl $box all"
1534	bind . <Key-A> "lblhkl $box all"
1535	bind . <Key-d> "delallhkllbl $box"
1536	bind . <Key-D> "delallhkllbl $box"
1537	if {[bind bltZoomGraph] != ""} {
1538	bind bltZoomGraph <Shift-Button-1> "lblhkl $box %x"
1539	bind bltZoomGraph <Shift-Button-3> "delallhkllbl %W"
1540	} else {
1541	bind $box <Shift-Button-1> "lblhkl $box %x"
1542	bind $box <Shift-Button-3> "delallhkllbl %W"
1543	}
1544	} else {
1545	$box element config 1 -label ""
1546	eval $box element config 4 $graph(ElementHideOption)
1547	}
1548	bind . <Key-z> {BLTmanualZoom}
1549	bind . <Key-Z> {BLTmanualZoom}
1550
1551	$box yaxis config -title {}
1552	setlegend $box $graph(legend)
1553
1554	frame .a -bd 3 -relief groove
1555	pack [menubutton .a.file -text File -underline 0 -menu .a.file.menu] -side left
1556	menu .a.file.menu
1557	.a.file.menu add cascade -label Tickmarks -menu .a.file.menu.tick
1558	menu .a.file.menu.tick
1559	foreach num {1 2 3 4 5 6 7 8 9} {
1560	.a.file.menu.tick add checkbutton -label "Phase $num" \
1561	-variable peakinfo(flag$num) \
1562	-command plotdata
1563	}
1564	.a.file.menu add cascade -label Histogram -menu .a.file.menu.hist -state disabled
1565	.a.file.menu add command -label "Update Plot" \
1566	-command {set cycle [getcycle];readdata .g}
1567	.a.file.menu add command -label "Make PostScript" -command makepostscriptout
1568	.a.file.menu add command -label Quit -command "destroy ."
1569
1570	pack [menubutton .a.options -text Options -underline 0 -menu .a.options.menu] \
1571	-side left
1572	menu .a.options.menu
1573	.a.options.menu add cascade -label "Configure Tickmarks" -menu .a.options.menu.tick
1574	menu .a.options.menu.tick
1575	.a.options.menu.tick add radiobutton -label "Manual Placement" \
1576	-value 0 -variable expgui(autotick) -command plotdata
1577	.a.options.menu.tick add radiobutton -label "Auto locate" \
1578	-value 1 -variable expgui(autotick) -command plotdata
1579	.a.options.menu.tick add separator
1580	foreach num {1 2 3 4 5 6 7 8 9} {
1581	.a.options.menu.tick add command -label "Phase $num" \
1582	-command "minioptionsbox $num"
1583	}
1584	if {$program == "liveplot"} {
1585	.a.options.menu add command -label "Obs symbol" -command getsymopts
1586	} else {
1587	.a.options.menu add cascade -label "Symbol Type" -menu .a.options.menu.sym
1588	menu .a.options.menu.sym
1589	foreach var {obs inp} lbl {Observed "Input bkg"} {
1590	.a.options.menu.sym add command -label $lbl -command "getsymopts $var"
1591	}
1592	}
1593	.a.options.menu add cascade -label "Symbol color" -menu .a.options.menu.color
1594	menu .a.options.menu.color
1595	set l1 {obs calc diff bkg chi2}
1596	set l2 {Observed Calculated Obs-Calc Background Cumulative-Chi2}
1597	if {$program != "liveplot"} {
1598	lappend l1 input fit
1599	lappend l2 "Input points" "Cheb. fit"
1600	}
1601
1602	foreach var $l1 lbl $l2 {
1603	.a.options.menu.color add command -label $lbl \
1604	-command "set graph(color_$var) \[tk_chooseColor -initialcolor \$graph(color_$var) -title \"Choose \$lbl color\"]; plotdata"
1605	}
1606	if {$expgui(tcldump) != "" && $program == "liveplot"} {
1607	.a.options.menu add cascade -label "X units" -menu .a.options.menu.xunits
1608	menu .a.options.menu.xunits
1609	.a.options.menu.xunits add radiobutton -label "As collected" \
1610	-variable graph(xunits) -value 0 \
1611	-command {set cycle [getcycle];readdata .g}
1612	.a.options.menu.xunits add radiobutton -label "d-space" \
1613	-variable graph(xunits) -value 1 \
1614	-command {set cycle [getcycle];readdata .g}
1615	.a.options.menu.xunits add radiobutton -label "Q" \
1616	-variable graph(xunits) -value 2 \
1617	-command {set cycle [getcycle];readdata .g}
1618	.a.options.menu add cascade -label "Y units" -menu .a.options.menu.yunits
1619	menu .a.options.menu.yunits
1620	.a.options.menu.yunits add radiobutton -label "As collected" \
1621	-variable graph(yunits) -value 0 \
1622	-command {set cycle [getcycle];readdata .g}
1623	.a.options.menu.yunits add radiobutton -label "Normalized" \
1624	-variable graph(yunits) -value 1 \
1625	-command {set cycle [getcycle];readdata .g}
1626	.a.options.menu add command -label "HKL labeling" -command setlblopts
1627	.a.options.menu add checkbutton -label "Subtract background" \
1628	-variable graph(backsub) \
1629	-command {set cycle [getcycle];readdata .g}
1630	} else {
1631	set graph(xunits) 0
1632	}
1633
1634	.a.options.menu add checkbutton -label "Include legend" \
1635	-variable graph(legend) \
1636	-command {setlegend $box $graph(legend)}
1637	.a.options.menu add command -label "Set PS output" -command setpostscriptout
1638	.a.options.menu add cascade -menu .a.options.menu.font \
1639	-label "Screen font"
1640	menu .a.options.menu.font
1641	foreach f {10 11 12 13 14 16 18 20 22} {
1642	.a.options.menu.font add radiobutton \
1643	-command {SetTkDefaultOptions $expgui(font); ResizeFont .} \
1644	-label $f -value $f -variable expgui(font) -font "Helvetica -$f"
1645	}
1646	if {$program == "liveplot"} {
1647	.a.options.menu add checkbutton -label "Raise on update" \
1648	-variable graph(autoraise)
1649	.a.options.menu add checkbutton -label "Cumulative Chi2" \
1650	-variable graph(chi2) -command ShowCumulativeChi2
1651	.a.options.menu add command -label "Save Options" -underline 1 \
1652	-command "SaveOptions"
1653	ShowCumulativeChi2
1654	} elseif {$program == "bkgedit"} {
1655	catch {pack [frame .bkg -bd 3 -relief sunken] -side bottom -fill both}
1656	grid [label .bkg.top -text "Background Point Editing"] \
1657	-col 0 -row 0 -columnspan 4
1658	grid [button .bkg.help -text Help -bg yellow \
1659	-command "MakeWWWHelp liveplot.html bkgedit"] \
1660	-column 5 -row 0 -rowspan 2 -sticky n
1661
1662	grid [frame .bkg.l -bd 3 -relief groove] \
1663	-col 0 -row 1 -columnspan 2 -sticky nse
1664	grid [label .bkg.l.1 -text "Mouse click\naction"] -col 0 -row 0
1665	foreach c {1 2 3} l {zoom add delete} {
1666	grid [button .bkg.l.b$c -text $l -command "bkgEditMode $c"] \
1667	-col $c -row 0
1668	}
1669	grid [frame .bkg.f -bd 3 -relief groove] \
1670	-col 3 -row 1 -columnspan 2 -sticky nsw
1671	grid [button .bkg.f.fit1 -text "Start\nFit" -command {bkgFit "" .bkg.f.fit1}] \
1672	-col 1 -row 1
1673	grid [button .bkg.f.fit2 -text "Improve\nFit" \
1674	-command {bkgFit $cheblist .bkg.f.fit2}] -col 2 -row 1
1675	grid [label .bkg.f.tl -text "with"] -col 3 -row 1
1676	set termmenu [tk_optionMenu .bkg.f.terms chebterms 0]
1677	grid .bkg.f.terms -col 4 -row 1
1678	grid [label .bkg.f.tl1 -text "terms"] -col 5 -row 1
1679
1680	grid [frame .bkg.c1 -bd 3 -relief groove] \
1681	-col 0 -row 5 -rowspan 2 -sticky nsew
1682	grid [label .bkg.c1.1 -text "Chebyshev\nterms"] -col 0 -row 0
1683	grid [canvas .bkg.canvas \
1684	-scrollregion {0 0 5000 500} -width 0 -height 0 \
1685	-xscrollcommand ".bkg.scroll set"] \
1686	-column 1 -row 5 -columnspan 3 -sticky nsew
1687	grid [scrollbar .bkg.scroll -command ".bkg.canvas xview" \
1688	-orient horizontal] -column 1 -row 6 -columnspan 3 -sticky nsew
1689	grid [button .bkg.cw -text "Save in EXP\nfile & Exit" \
1690	-command "bkgChebSave;exit"] \
1691	-col 4 -columnspan 2 -row 5 -rowspan 2 -sticky ns
1692
1693	grid [frame .bkg.bl -bd 3 -relief groove] \
1694	-col 0 -row 3 -rowspan 2 -sticky nsew
1695	grid [label .bkg.bl.1 -text "Background\npoints"] -col 0 -row 0
1696	grid [canvas .bkg.bc \
1697	-scrollregion {0 0 5000 500} -width 0 -height 0 \
1698	-xscrollcommand ".bkg.bs set"] \
1699	-column 1 -row 3 -columnspan 5 -sticky nsew
1700	grid [scrollbar .bkg.bs -command ".bkg.bc xview" -orient horizontal] \
1701	-column 1 -row 4 -columnspan 5 -sticky nsew
1702
1703	grid columnconfigure .bkg 1 -weight 1
1704	grid columnconfigure .bkg 2 -weight 1
1705	grid columnconfigure .bkg 3 -weight 1
1706	grid rowconfigure .bkg 3 -weight 1
1707	grid rowconfigure .bkg 5 -weight 1
1708	.g config -title ""
1709	}
1710
1711	pack [menubutton .a.help -text Help -underline 0 -menu .a.help.menu] -side right
1712	menu .a.help.menu -tearoff 0
1713	.a.help.menu add command -command "MakeWWWHelp liveplot.html" -label "Web page"
1714	.a.help.menu add command -command aboutliveplot -label About
1715
1716	pack .a -side top -fill both
1717	pack $box -fill both -expand yes
1718
1719	# add the extra options
1720	set fl [file join $expgui(scriptdir) icddcmd.tcl]
1721	if [file exists $fl] {source $fl}
1722	set fl [file join $expgui(scriptdir) cellgen.tcl]
1723	if [file exists $fl] {source $fl}
1724
1725	expload $expnam.EXP
1726	mapexp
1727
1728	# fill the histogram menu
1729	if {[llength $expmap(powderlist)] > 15} {
1730	set expgui(plotlist) {}
1731	.a.file.menu entryconfigure Histogram -state normal
1732	menu .a.file.menu.hist
1733	set i 0
1734	foreach num [lsort -integer $expmap(powderlist)] {
1735	incr i
1736	# for now include, but disable histograms
1737	set state disabled
1738	if {[string range $expmap(htype_$num) 3 3] != "*"} {
1739	set state normal
1740	lappend expgui(plotlist) $num
1741	}
1742	if {$i == 1} {
1743	set num1 $num
1744	menu .a.file.menu.hist.$num1
1745	}
1746	.a.file.menu.hist.$num1 add radiobutton -label $num -value $num \
1747	-variable hst -state $state \
1748	-command {set cycle [getcycle];readdata .g}
1749	if {$i >= 10} {
1750	set i 0
1751	.a.file.menu.hist add cascade -label "$num1-$num" \
1752	-menu .a.file.menu.hist.$num1
1753	}
1754	}
1755	if {$i != 0} {
1756	.a.file.menu.hist add cascade -label "$num1-$num" \
1757	-menu .a.file.menu.hist.$num1
1758	}
1759	} elseif {[llength $expmap(powderlist)] > 1} {
1760	set expgui(plotlist) {}
1761	.a.file.menu entryconfigure Histogram -state normal
1762	menu .a.file.menu.hist
1763	foreach num [lsort -integer $expmap(powderlist)] {
1764	# for now include, but disable unprocessed histograms
1765	set state disabled
1766	if {[string range $expmap(htype_$num) 3 3] != "*"} {
1767	set state normal
1768	lappend expgui(plotlist) $num
1769	}
1770	.a.file.menu.hist add radiobutton -label $num -value $num \
1771	-variable hst -state $state \
1772	-command {set cycle [getcycle];readdata .g}
1773	}
1774	} else {
1775	set expgui(plotlist) [lindex $expmap(powderlist) 0]
1776	}
1777	# N = load next histogram
1778	bind . <Key-n> {
1779	set i [lsearch $expgui(plotlist) $hst]
1780	incr i
1781	if {$i >= [llength $expgui(plotlist)]} {set i 0}
1782	set hst [lindex $expgui(plotlist) $i]
1783	set cycle [getcycle];readdata .g
1784	}
1785	bind . <Key-N> {
1786	set i [lsearch $expgui(plotlist) $hst]
1787	incr i
1788	if {$i >= [llength $expgui(plotlist)]} {set i 0}
1789	set hst [lindex $expgui(plotlist) $i]
1790	set cycle [getcycle];readdata .g
1791	}
1792	updateifnew
1793	donewaitmsg
1794	trace variable peakinfo w plotdataupdate

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

Download in other formats:

Original Format