Context Navigation

source: trunk/liveplot @ 420

Last change on this file since 420 was 420, checked in by toby, 14 years ago
# on 2001/09/04 22:09:40, toby did: reset bkgedit zoom
Property rcs:author set to `toby` Property rcs:date set to `2001/09/04 22:09:40` Property rcs:lines set to `+4 -0` Property rcs:rev set to `1.17` Property rcs:state set to `Exp` Property svn:keywords set to `Author Date Revision Id`
File size: 46.8 KB

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

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

Download in other formats:

Original Format