Context Navigation

source: trunk/expgui @ 74

Last change on this file since 74 was 74, checked in by toby, 14 years ago
# on 1999/03/30 16:18:11, toby did: Set expnam on command line to upper case move expgui to center of screen window, if we will put the file open on top. This is because the open window can end up partly off screen otherwise.
Property rcs:author set to `toby` Property rcs:date set to `1999/03/30 16:18:11` Property rcs:lines set to `+19 -2` Property rcs:rev set to `1.13` Property rcs:state set to `Exp` Property svn:keywords set to `Author Date Revision Id`
File size: 108.7 KB

Line
1	#!/usr/local/bin/wish
2	set expgui(Revision) {$Revision: 74 $ $Date: 2009-12-04 22:59:58 +0000 (Fri, 04 Dec 2009) $}
3
4	# to do:
5	#
6	# need to change heading and button label depending on where getExpFileName
7	# is called from
8	#
9	# fixup documentation and you are done!
10	#
11	# global background editing & profile work differently: should both
12	# start out blank with a "load from option"?
13	#
14	# idea:
15	# a scroll list for all histogram refinement flags ; click on takes you to the
16	# appropriate menu.
17	#
18	# to allow "global" access on phase page
19	# change buttons from radio to multiple
20	# -- or display all 9 cell flag/damps and all atoms
21	# make editMultipleRecords work with multiple phases, also cell flag/damp
22	# blank cell entries
23	# add phase to atom number in listing
24	# DisplayAllAtoms needs to loop over phases: expgui(curPhase)
25
26	if {$tcl_version < 8.0} {
27	tk_dialog .expFileErrorMsg "Version Error" \
28	"The program requires Tcl/Tk version 8.0 or higher" error 0 "Exit"
29	exit
30	}
31
32	if {$argv != ""} {
33	set expgui(expfile) $argv
34	if {[string toupper [file extension $expgui(expfile)]] != ".EXP"} {
35	append expgui(expfile) ".EXP"
36	}
37	if {[file dirname $expgui(expfile)] == "."} {
38	set expgui(expfile) [string toupper $expgui(expfile)]
39	} else {
40	set expgui(expfile) [file join \
41	[file dirname $expgui(expfile)] \
42	[file tail [string toupper $expgui(expfile)]]
43	]
44	}
45	} else {
46	set expgui(expfile) {}
47	}
48
49	set expgui(debug) 0
50	catch {if $env(DEBUG) {set expgui(debug) 1}}
51	#set expgui(debug) 1
52
53	set expgui(havetix) 1
54	# for debugging non-Tix version set environment variable NOTIX
55	catch {if $env(NOTIX) {set expgui(havetix) 0}}
56	if $expgui(havetix) {
57	if [catch {package require Tix}] {set expgui(havetix) 0}
58	}
59	# default is archive = on
60	set expgui(archive) 1
61	# save the name of the wish executable
62	set wishshell [info nameofexecutable]
63	# misc constants
64	set expgui(coordfont) "--courier-bold-r-normal--12-"
65	set expgui(histfont) "--courier-bold-r-normal--12-"
66	set liveplot(hst) 1
67	set liveplot(legend) 1
68	set expgui(filesort) 1
69
70	#=============================================================================
71	# Store names of profile terms.
72	array set expgui {
73	prof-T-1 {TOF-type1 alp-0 bet-0 sig-0 alp-1 bet-1 sig-1 rstr rsta \
74	sig-2 rsca s1ec s2ec }
75	prof-T-2 {TOF-type2 alp-0 sig-0 gam-0 alp-1 sig-1 gam-1 beta sig-2 \
76	gam-2 switch ptec stec difc difa zero }
77	prof-T-3 {TOF-type3 alp bet-0 bet-1 sig-0 sig-1 sig-2 gam-0 gam-1 \
78	gam-2 gsf g1ec g2ec rstr rsta rsca L11 L22 L33 L12 L13 L23 }
79	prof-T-4 {TOF-type4 alp bet-0 bet-1 sig-1 sig-2 gam-2 g2ec gsf \
80	rstr rsta rsca eta}
81	prof-C-1 {CW-type U V W asym F1 F2 }
82	prof-C-2 {CW-type2 GU GV GW LX LY trns asym shft GP stec ptec sfec \
83	L11 L22 L33 L12 L13 L23 }
84	prof-C-3 {CW-type3 GU GV GW GP LX LY S/L H/L trns shft stec ptec sfec \
85	L11 L22 L33 L12 L13 L23 }
86	prof-C-4 {CW-type4 GU GV GW GP LX ptec trns shft sfec S/L H/L eta}
87	}
88	# >>>>>>>>>>>>>>>> End of Profile Terms >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
89	#----------------------------------------------------------------
90	# where are we?
91	set expgui(script) [info script]
92	# translate links -- go six levels deep
93	foreach i {1 2 3 4 5 6} {
94	if {[file type $expgui(script)] == "link"} {
95	set link [file readlink $expgui(script)]
96	if { [file pathtype $link] == "absolute" } {
97	set expgui(script) $link
98	} {
99	set expgui(script) [file dirname $expgui(script)]/$link
100	}
101	} else {
102	break
103	}
104	}
105	# fixup relative paths
106	if {[file pathtype $expgui(script)] == "relative"} {
107	set expgui(script) [file join [pwd] $expgui(script)]
108	}
109	set expgui(scriptdir) [file dirname $expgui(script) ]
110	set expgui(gsasdir) [file dirname $expgui(scriptdir)]
111	set expgui(gsasexe) [file join $expgui(gsasdir) exe]
112	#----------------------------------------------------------------
113	# fetch EXP file processing routines
114	source [file join $expgui(scriptdir) readexp.tcl]
115	# commands for running GSAS programs
116	source [file join $expgui(scriptdir) gsascmds.tcl]
117	# contents of GSAS menus
118	source [file join $expgui(scriptdir) gsasmenu.tcl]
119	#---------------------------------------------------------------------------
120	# override options with locally defined values
121	if [file exists [file join $expgui(scriptdir) localconfig]] {
122	source [file join $expgui(scriptdir) localconfig]
123	}
124	if [file exists [file join ~ .gsas_config]] {
125	source [file join ~ .gsas_config]
126	}
127	#---------------------------------------------------------------------------
128	if {$expgui(expfile) != ""} {
129	if ![file exists $expgui(expfile)] {
130	update
131	set ans [tk_dialog .expFileErrorMsg "File Open Error" \
132	"File [file tail $expgui(expfile)] does not exist in [file dirname $expgui(expfile)]" \
133	error 0 "Create" "Open other"]
134	if $ans {set expgui(expfile) {}}
135	}
136	}
137	if {$expgui(expfile) == ""} {
138	# center the parent window because the getExpFileName window
139	# will be centered above it.
140	wm withdraw .
141	set x [expr [winfo screenwidth .]/2 - [winfo reqwidth .]/2 ]
142	set y [expr [winfo screenheight .]/2 - [winfo reqheight .]/2]
143	wm geom . +$x+$y
144	wm deiconify .
145	# windows needed this update before when using tk_getOpenFile.
146	# I am not sure it is still needed.
147	update
148	#
149	set expgui(expfile) [getExpFileName old]
150	}
151	if {$expgui(expfile) == ""} exit
152	# you've been warned this .EXP does not exist!
153	if ![file exists $expgui(expfile)] {
154	# create an "empty" exp file
155	createexp $expgui(expfile) \
156	[getstring "title for experiment $expgui(expfile)" 60 0]
157	}
158	catch {cd [string trim [file dirname $expgui(expfile)]]}
159
160	#
161	# >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
162	# <<<<<<<<<< BEGINNING OF MAIN: GLOBAL AREA FOR DATA EXTRACTION >>>>>>>>>>>
163	# >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
164	# load exp file and set up dialogs
165	proc loadexp {expfile} {
166	global expgui expmap entryvar entrycmd
167	global exparray
168	catch {
169	unset exparray
170	}
171	expload $expfile
172	set expgui(changed) 0
173	mapexp
174	set expgui(expModifiedLast) [file mtime $expfile]
175	set expgui(last_History) [string range [string trim [lindex [exphistory last] 1]] 0 50 ]
176	# set the window/icon title
177	wm title . $expfile
178	set expgui(titleunchanged) 1
179	wm iconname . [file tail $expfile]
180
181	# set the number of phases on the phase page
182	setphases
183
184	# disable the "global options" that don't make sense based
185	# on the histograms present
186	foreach num {1 2 3 4 5} {
187	set flag($num) 0
188	}
189	foreach h $expmap(powderlist) {
190	if {[string range $expmap(htype_$h) 2 2] == "T"} {set flag(1) 1}
191	if {[string range $expmap(htype_$h) 1 2] == "NC"} {set flag(2) 1}
192	if {[string range $expmap(htype_$h) 1 2] == "XC" && \
193	[histinfo $h lam2] != 0.0} {set flag(3) 1}
194	if {[string range $expmap(htype_$h) 1 2] == "XC" && \
195	[histinfo $h lam2] == 0.0} {set flag(4) 1}
196	if {[string range $expmap(htype_$h) 1 2] == "XE"} {set flag(5) 1}
197	}
198	foreach num {1 2 3 4 5} \
199	lbl {TOF "CW Neutron" "Alpha12 Xray" "Monochromatic Xray" \
200	"Energy Disp Xray"} {
201	if $flag($num) {
202	$expgui(fm).option.menu.editmode entryconfigure $lbl -state normal
203	} else {
204	$expgui(fm).option.menu.editmode entryconfigure $lbl -state disabled
205	}
206	}
207	# disable traces on entryvar until we are ready
208	set entrycmd(trace) 0
209
210	# propogate changes on the least squares page
211	set entryvar(cycles) [expinfo cycles]
212	set entrycmd(cycles) "expinfo cycles"
213	set expgui(globalmode) 0
214	set expgui(printopt) "Print Options ([expinfo print])"
215	set entryvar(title) [expinfo title]
216	global printopts
217	foreach num [array names printopts] {
218	set entrycmd(printopt$num) "printsetting $num"
219	set entryvar(printopt$num) [printsetting $num]
220	}
221	# enable traces on entryvar
222	set entrycmd(trace) 1
223	# set fo extaction on LS page
224	SetupExtractHist
225
226	# update the histogram list & the page, if shown
227	sethistlist
228
229	# update the atoms display
230	# DisplayAllAtoms noreset
231	SelectOnePhase $expgui(curPhase)
232
233	# start checking for external changes
234	afterawhile
235	}
236
237	# called to reread the .EXP file -- use after another program
238	# has changed the experiment file
239	proc rereadexp {expfile} {
240	global expgui
241	if $expgui(changed) {
242	set decision [tk_dialog .instrSaveData {Save .EXP changes} \
243	{You have made changes to the Experiment. Rereading will cause the changes to be lost. Select an option:} \
244	{} 0 "Save and reread" "Reread without Save" "Cancel reread command"]
245	switch $decision {
246	0 { savearchiveexp }
247	1 { }
248	2 { return }
249	}
250	}
251	loadexp $expgui(expfile)
252	}
253
254	proc SaveAsFile {} {
255	global expgui
256	set newexpfile [getExpFileName new]
257	if {$newexpfile == ""} return
258	expwrite $newexpfile
259	set expgui(expfile) $newexpfile
260	catch {cd [string trim [file dirname $expgui(expfile)]]}
261	set expgui(changed) 0
262	set expgui(expModifiedLast) [file mtime $expgui(expfile)]
263	set expgui(last_History) [string range [string trim [lindex [exphistory last] 1]] 0 50 ]
264	# set the window/icon title
265	wm title . $expgui(expfile)
266	set expgui(titleunchanged) 1
267	wm iconname . [file tail $expgui(expfile)]
268	}
269
270	# called to read a different .EXP file
271	proc readnewexp {} {
272	global expgui expmap
273	if $expgui(changed) {
274	set decision [tk_dialog .instrSaveData {Save .EXP changes} \
275	{You have made changes to the Experiment. Reading a different file will cause the changes to be lost. Select an option:} \
276	{} 0 "Save and read" "Read without Save" "Cancel read command"]
277	switch $decision {
278	0 { savearchiveexp }
279	1 { }
280	2 { return }
281	}
282	}
283	set newexpfile [getExpFileName old]
284	if {$newexpfile == ""} return
285
286	if ![file exists $newexpfile] {
287	# you've been warned this .EXP does not exist!
288	# create an "empty" exp file
289	createexp $newexpfile \
290	[getstring "title for experiment $newexpfile" 60 0]
291	}
292	set expgui(expfile) $newexpfile
293	catch {cd [string trim [file dirname $expgui(expfile)]]}
294	loadexp $expgui(expfile)
295
296	# select the 1st phase
297	SelectOnePhase [lindex $expmap(phaselist) 0]
298	# select the first histogram in the list by default (if there are any)
299	if {[llength $expmap(histlistboxcontents)] > 0} {
300	set expgui(curhist) 0
301	} else {
302	set expgui(curhist) {}
303	}
304	if !$expgui(havetix) {
305	RaisePage lsFrame
306	} else {
307	.n raise lsPane
308	set expgui(pagenow) lsFrame
309	}
310	}
311
312	#------------- set up data read/write layer ----------------------
313	# trace routine on entryvar
314	proc entvartrace {array elem action} {
315	global expgui entrycmd entryvar
316	if !$entrycmd(trace) return
317
318	catch {
319	if {$entrycmd($elem) == ""} return
320	incr expgui(changed)
321	if $expgui(debug) {puts "$entrycmd($elem) set $entryvar($elem) "}
322	if {$entrycmd($elem) == ""} return
323	if [catch {
324	eval $entrycmd($elem) set [list $entryvar($elem)]
325	if {[lindex $entrycmd($elem) 0] == "atominfo"} {
326	after idle {DisplayAllAtoms noreset}
327	}
328	} errmsg] {puts "entvartrace error: $errmsg"}
329	}
330	}
331
332	# disable traces on entryvar until we are ready
333	set entrycmd(trace) 0
334	trace variable entryvar w entvartrace
335
336	#
337	#
338	#
339	##############################################################################
340	##### #####################################################
341	##### PROCEDURES SECTION #####################################################
342	##### #####################################################
343	##############################################################################
344	# reset routine is used for debugging
345	proc reset {} {
346	global expgui script argv
347	set script $expgui(script)
348	set argv $expgui(expfile)
349	# remove traces
350	global entryvar
351	foreach cmd [trace vinfo entryvar] {
352	eval trace vdelete entryvar $cmd
353	}
354	global expgui
355	foreach cmd [trace vinfo expgui(backterms)] {
356	eval trace vdelete entryvar $cmd
357	}
358	foreach cmd [trace vinfo expgui(backtype)] {
359	eval trace vdelete entryvar $cmd
360	}
361	foreach a {
362	exparray expmap expgui entryvar entrycmd
363	expgui_menulist expgui_cmdlist expgui_helplist
364	} {
365	global $a
366	catch {unset $a}
367	}
368	foreach w [winfo children .] {
369	destroy $w
370	}
371
372	uplevel #0 {source $script}
373	}
374
375	# save some of the global options in ~/.gsas_config
376	proc SaveOptions {} {
377	global expgui env tcl_platform
378	set fp [open [file join ~ .gsas_config] a]
379	puts $fp "set expgui(archive) $expgui(archive)"
380	puts $fp "set expgui(asorttype) $expgui(asorttype)"
381	puts $fp "set expgui(hsorttype) $expgui(hsorttype)"
382	puts $fp "set expgui(filesort) $expgui(filesort)"
383	if {$tcl_platform(platform) != "windows"} {
384	puts $fp "set env(GSASBACKSPACE) $env(GSASBACKSPACE)"
385	}
386	close $fp
387	}
388
389	proc About { } {
390	global expgui expmap
391	tk_dialog .about {About...} \
392	"EXPGUI\n\
393	Jonathan Wasserman and Brian Toby\n\
394	NIST Center for Neutron Research\n\n\
395	1998, Not subject to copyright\n\n\
396	Revision [lindex $expgui(Revision) 1] (readexp.tcl [lindex $expmap(Revision) 1])\n\n\
397	Generalized Structure Analysis System (GSAS)\n\
398	A. C. Larson and\n R. B. Von Dreele,\n LANSCE, Los Alamos\n\n\
399	" \
400	info 0 OK
401	}
402
403	# wait until idle
404	proc afterawhile {} {
405	# cancel any other instances of this loop
406	after cancel afterawhile
407	after cancel whenidle
408	after cancel whenidle
409	after idle whenidle
410	}
411
412	proc whenidle {} {
413	global expgui
414	if $expgui(titleunchanged) {
415	if {$expgui(changed) != 0} {
416	wm title . "$expgui(expfile) (modified)"
417	set expgui(titleunchanged) 0
418	}
419	}
420	if {[file mtime $expgui(expfile)] != $expgui(expModifiedLast)} {
421	if {$expgui(changed) == 0} {
422	set ans [tk_dialog .expFileErrorMsg "Reload?" \
423	"File [file tail $expgui(expfile)] has been modified by another program. \
424	Do you want to load the newer version or lose the modifications \
425	by editing the current version?" \
426	warning 0 "Load new" "Continue editing"]
427	} else {
428	set ans [tk_dialog .expFileErrorMsg "Reload?" \
429	"File [file tail $expgui(expfile)] has been modified by another program \
430	and you have made $expgui(changed) changes to this version. \
431	Do you want to load the newer version or lose the modifications \
432	by continuing to edit the current version?" \
433	warning 0 "Load new" "Continue editing" "Save edited version"]
434	}
435	if {$ans == 0} {
436	loadexp $expgui(expfile)
437	} elseif {$ans == 1} {
438	# reset the time to the next version
439	set expgui(expModifiedLast) [file mtime $expgui(expfile)]
440	} elseif {$ans == 2} {
441	savearchiveexp
442	}
443	}
444	after 2000 afterawhile
445	}
446	# -------- called to confirm before exiting
447	proc catchQuit {} {
448	if {[confirmBeforeSave] == "Continue"} {
449	destroy .
450	}
451	}
452	# save the .EXP file before exiting?
453	proc confirmBeforeSave {} {
454	global expgui
455	if !$expgui(changed) {
456	return "Continue"
457	}
458	set decision [tk_dialog .instrSaveData {Save .EXP changes} \
459	{You have made changes to the Experiment, but the changes are not saved. Select an option:} \
460	{} 0 "Save and Exit" "Exit without Save" "Cancel exit command"]
461	switch $decision {
462	0 { savearchiveexp; return "Continue" }
463	1 { return "Continue" }
464	2 { return "Cancel" }
465	}
466	}
467
468	proc archiveexp {} {
469	global expgui tcl_platform
470	catch {
471	set expnam [file rootname $expgui(expfile)]
472	if {$tcl_platform(platform) == "windows"} {
473	if ![file executable [file join $expgui(scriptdir) pkzip.exe]] {
474	# archive w/o pkzip
475	set files [glob -nocomplain ${expnam}!*.exp]
476	if {$files == ""} {
477	set num -1
478	} else {
479	set file [lindex [lsort -decreasing $files] 0]
480	regexp {!([0-9]+)\.EXP} [string toupper $file] a num
481	}
482	set file $expnam![format "%3.3d" [incr num]].EXP
483	file copy $expnam.EXP $file
484	set fp [open $expnam.lst a]
485	puts $fp "\n--------------------------------------------------------------"
486	puts $fp "Archiving $expnam.EXP as $file"
487	puts $fp "--------------------------------------------------------------\n"
488	close $fp
489	} else {
490	# archive with PKZIP
491	# need to limit expnam to 8 characters
492	set sexp [string toupper [string range [file root [file tail $expnam] ] 0 7]]
493	# PKZIP can't handle long dir names either
494	cd [set dir [file dirname $expnam]]
495	set num -1
496	# get the versions from the listing
497	if [file exists $sexp.zip] {
498	set fp [open "\| [file join $expgui(scriptdir) pkzip.exe] -vb $sexp" r]
499	while {[gets $fp line] >= 0} {
500	regexp "$sexp\.0?0?(\[0-9\]+)" [string toupper $line] junk n
501	catch {if {$n > $num} {set num $n}}
502	}
503	close $fp
504	}
505	incr num
506	set file $sexp.[format "%3.3d" $num]
507	file copy -force $expnam.EXP $file
508	exec [file join $expgui(scriptdir) pkzip.exe] -m $expnam $file > x.x &
509	set fp [open $expnam.lst a]
510	puts $fp "\n--------------------------------------------------------------"
511	puts $fp "Archiving $expnam.EXP as $file in [file join $dir $sexp.ZIP]"
512	puts $fp "--------------------------------------------------------------\n"
513	close $fp
514	}
515	} else {
516	set files [glob -nocomplain $expnam.EXP.*]
517	if {$files == ""} {
518	set file $expnam.EXP.000
519	} else {
520	set file [lindex [lsort -decreasing $files] 0]
521	regexp {.\.EXP.0?0?([0-9]).*} $file junk number
522	incr number
523	set file $expnam.EXP.[format "%3.3d" $number]
524	}
525	exec cp $expgui(expfile) $file
526	if [catch {exec gzip $file}] {
527	exec echo "\n----------------------------------------------" >> $expnam.LST
528	exec echo " Archiving $expnam.EXP as $file " >> $expnam.LST
529	exec echo "----------------------------------------------\n" >> $expnam.LST
530	} else {
531	exec echo "\n----------------------------------------------" >> $expnam.LST
532	exec echo " Archiving $expnam.EXP as $file.gz " >> $expnam.LST
533	exec echo "----------------------------------------------\n" >> $expnam.LST
534	}
535	}
536	} errmsg
537	if {$errmsg != ""} {
538	tk_dialog .warn Confirm "Error in archive: $errmsg" warning 0 OK
539	}
540	}
541
542	# save and optionally archive the expfile
543	proc savearchiveexp {} {
544	global expgui expmap
545	if !$expgui(changed) return
546	if $expgui(archive) archiveexp
547	# add a history record
548	exphistory add " EXPGUI [lindex $expgui(Revision) 1] [lindex $expmap(Revision) 1] ($expgui(changed) changes) -- [clock format [clock seconds]]"
549	# now save the file
550	expwrite $expgui(expfile)
551	set expgui(changed) 0
552	set expgui(expModifiedLast) [file mtime $expgui(expfile)]
553	set expgui(last_History) [string range [string trim [lindex [exphistory last] 1]] 0 50 ]
554	wm title . $expgui(expfile)
555	set expgui(titleunchanged) 1
556	}
557
558	# set the number of phases on the phase page
559	proc setphases {} {
560	global expgui expmap
561	eval destroy [pack slaves $expgui(phaseFrame).top.ps]
562	foreach num $expmap(phaselist) {
563	pack [button $expgui(phaseFrame).top.ps.$num -text $num \
564	-command "SelectOnePhase $num"] -side left
565	}
566	}
567
568	# Procedure to respond to changes the phase.
569	# This loads the "phases" widgets with data corresponding to the selected phase.
570	proc SelectOnePhase {num} {
571	global entryvar entrycmd expmap expgui
572	foreach n $expmap(phaselist) {
573	if {$n == $num} {
574	$expgui(phaseFrame).top.ps.$num config -relief sunken
575	} else {
576	$expgui(phaseFrame).top.ps.$n config -relief raised
577	}
578	}
579	set crsPhase $num
580	# no phase is selected
581	if {$crsPhase == "" \|\| [llength $expmap(phaselist)] == 0} {
582	# disable traces on entryvar
583	set entrycmd(trace) 0
584	set entrycmd(phasename) ""
585	set entryvar(phasename) ""
586	foreach ent {a b c alpha beta gamma cellref celldamp} {
587	set entrycmd($ent) ""
588	set entryvar($ent) ""
589	}
590	set expgui(curPhase) {}
591	# enable traces on entryvar
592	set entrycmd(trace) 1
593	return
594	}
595
596	set expgui(curPhase) $crsPhase
597	# we have a phase
598
599	# disable traces on entryvar for right now
600	set entrycmd(trace) 0
601
602	##########################################################
603	###### SECTION: ASSIGNMENT OF DATA VARIABLES ##########
604	##########################################################
605	# phase title
606	set entrycmd(phasename) "phaseinfo $crsPhase name"
607	set entryvar(phasename) [phaseinfo $crsPhase name]
608	# cell parameters & flags
609	foreach ent {a b c alpha beta gamma cellref celldamp} {
610	set entrycmd($ent) "phaseinfo $crsPhase $ent"
611	set entryvar($ent) [phaseinfo $crsPhase $ent]
612	}
613
614	#Procedure call: DisplayU -- Display Anisotropic/Isotropic widget or disable
615	# initialize to diasbled
616	DisplayAtom 0 0
617	DisplayU 0 0
618	DisplayRefFlags 0 0
619	$expgui(EditingAtoms) config -text ""
620
621	DisplayAllAtoms
622
623	# enable traces on entryvar now
624	set entrycmd(trace) 1
625	}
626
627	set expgui(noreenterDisplayAllAtoms) 0
628	# Populate expgui(atomlistbox) (ScrolledListBox) with atoms from selected phase.
629	proc DisplayAllAtoms {"mode reset"} {
630	global entryvar entrycmd expmap expgui
631	# if it does not show, dont bother
632	if {$expgui(pagenow) != "phaseFrame"} return
633	if {$expgui(curPhase) == ""} return
634	if $expgui(noreenterDisplayAllAtoms) return
635
636	set expgui(noreenterDisplayAllAtoms) 1
637	if {$mode != "reset"} {
638	# save the scrolled position
639	set pos [lindex [$expgui(atomlistbox) yview] 0]
640	} else {
641	# this is a reset -- clear the selected atoms list
642	set expgui(selectedatomlist) {}
643	}
644	$expgui(atomlistbox) delete 0 end
645	# loop over atoms
646	set maxline I
647	set phase $expgui(curPhase)
648	set atomlist {}
649	if {$expgui(asorttype) == "type"} {
650	# sort on atom type
651	foreach atom $expmap(atomlist_$phase) {
652	lappend atomlist "$atom [atominfo $phase $atom type] $phase"
653	}
654	set expmap(atomlistboxcontents) [lsort -ascii -index 1 $atomlist]
655	} elseif {$expgui(asorttype) == "number"} {
656	# sort on atom number
657	foreach atom $expmap(atomlist_$phase) {
658	lappend atomlist "$atom $atom $phase"
659	}
660	set expmap(atomlistboxcontents) [lsort -integer -index 1 $atomlist]
661	} elseif {$expgui(asorttype) == "x"} {
662	# sort on x
663	foreach atom $expmap(atomlist_$phase) {
664	lappend atomlist "$atom [atominfo $phase $atom x] $phase"
665	}
666	set expmap(atomlistboxcontents) [lsort -real -index 1 $atomlist]
667	} elseif {$expgui(asorttype) == "y"} {
668	# sort on y
669	foreach atom $expmap(atomlist_$phase) {
670	lappend atomlist "$atom [atominfo $phase $atom y] $phase"
671	}
672	set expmap(atomlistboxcontents) [lsort -real -index 1 $atomlist]
673	} elseif {$expgui(asorttype) == "z"} {
674	# sort on z
675	foreach atom $expmap(atomlist_$phase) {
676	lappend atomlist "$atom [atominfo $phase $atom z] $phase"
677	}
678	set expmap(atomlistboxcontents) [lsort -real -index 1 $atomlist]
679	} else {
680	error "Bad expgui(asorttype = $expgui(asorttype)"
681	}
682
683	foreach tuple $expmap(atomlistboxcontents) {
684	set atom [lindex $tuple 0]
685	set phase [lindex $tuple 2]
686	set refflag {}
687	foreach type {x u f} {
688	if {[atominfo $phase $atom ${type}ref]} {
689	append refflag "[string toupper $type][atominfo $phase $atom ${type}damp] "
690	} else {
691	append refflag " [atominfo $phase $atom ${type}damp] "
692	}
693	}
694	set line [format "%3d %-6s %-6s %8s %10.6f%10.6f%10.6f%9.4f" \
695	$atom \
696	[atominfo $phase $atom label] \
697	[atominfo $phase $atom type] \
698	$refflag \
699	[atominfo $phase $atom x] \
700	[atominfo $phase $atom y] \
701	[atominfo $phase $atom z] \
702	[atominfo $phase $atom frac]
703	]
704	# add temperature factors (iso/anoiso)
705	if {[atominfo $phase $atom temptype] == "A"} {
706	set maxline A
707	append line [format " %9.5f%9.5f%9.5f%9.5f%9.5f%9.5f" \
708	[atominfo $phase $atom U11] \
709	[atominfo $phase $atom U22] \
710	[atominfo $phase $atom U33] \
711	[atominfo $phase $atom U12] \
712	[atominfo $phase $atom U23] \
713	[atominfo $phase $atom U13]
714	]
715	} else {
716	append line [format " %9.5f" \
717	[atominfo $phase $atom Uiso]
718	]
719	}
720	$expgui(atomlistbox) insert end $line
721	}
722	$expgui(atomtitle) delete 0 end
723	if {$maxline == "A"} {
724	$expgui(atomtitle) insert end [format "%10s %6s %8s %30s%9s %s" \
725	" name " "type " "ref/damp " "fractional coordinates " \
726	" Occupancy" \
727	"Uiso/Uij "]
728	} else {
729	$expgui(atomtitle) insert end [format "%10s %6s %8s %30s%9s %s" \
730	" name " "type " "ref/damp " "fractional coordinates " \
731	" Occupancy" \
732	"Uiso"]
733	}
734	if {$mode != "reset"} {
735	# restore the selected items
736	foreach i $expgui(selectedatomlist) {
737	$expgui(atomlistbox) selection set $i
738	}
739	# restore the last scrolled position
740	$expgui(atomlistbox) yview moveto $pos
741	}
742	set expgui(noreenterDisplayAllAtoms) 0
743	}
744
745	# Procedure to select all atoms in response to a right-click
746	proc SelectAllAtoms {} {
747	global expgui
748	$expgui(atomlistbox) selection set 0 end
749	# call editRecord in case trace was called before the selection was made
750	editRecord
751	}
752
753	# Procedure to respond to left mouse release in the atoms Pane
754	proc editRecord { args } {
755	global entrycmd expgui
756	set expgui(selectedatomlist) [$expgui(atomlistbox) curselection]
757	# disable traces on entryvar for right now
758	set entrycmd(trace) 0
759
760	if {[llength $expgui(selectedatomlist)] == 0} {
761	puts "How did this happen: [$expgui(atomlistbox) curselection]"
762	} elseif {[llength $expgui(selectedatomlist)] == 1} {
763	editOneRecord $expgui(selectedatomlist)
764	} else {
765	editMultipleRecords $expgui(selectedatomlist)
766	}
767	# reenable traces on entryvar
768	set entrycmd(trace) 1
769	# repaint the atoms box in case anything was changed
770	# DisplayAllAtoms noreset
771	}
772
773	proc editOneRecord { AtomIndex } {
774	global expmap expgui
775	# get atom number & phase
776	set tuple [lindex $expmap(atomlistboxcontents) $AtomIndex]
777	set atomnum [lindex $tuple 0]
778	set p [lindex $tuple 2]
779	DisplayU $atomnum $p
780	DisplayAtom $atomnum $p
781	DisplayRefFlags $atomnum $p
782	$expgui(EditingAtoms) config -text "Editing atom #$atomnum -- [atominfo $p $atomnum label]"
783	}
784
785	# this will not work for a multi-phase list of atoms (yet)
786	proc editMultipleRecords { AtomIndexList } {
787	global expmap expgui
788	set numberList {}
789	# current phase
790	set p $expgui(curPhase)
791	foreach AtomIndex $AtomIndexList {
792	# get atom number & phase
793	set tuple [lindex $expmap(atomlistboxcontents) $AtomIndex]
794	lappend numberList [lindex $tuple 0]
795	# set p [lindex $tuple 2]
796	}
797	# this needs to track by phase
798	$expgui(EditingAtoms) config -text \
799	"Set refinement options: atoms [CompressList $numberList]"
800	DisplayU 0 0
801	DisplayAtom 0 0
802	# this needs to track by phase
803	DisplayRefFlags $numberList $p
804	}
805
806	# format a string of numbers to save space, e.g. "1 2 3 4 6 7 19 13 14 15"
807	# becomes "1-4,6,7,13-15,19"
808	proc CompressList {numberList} {
809	# format the number list to save space
810	set lastnum -99
811	set flist {}
812	set count 0
813	foreach num [lsort -integer $numberList] {
814	set next [expr $lastnum+1]
815	if {$num != $next} {
816	if {$count == 0 && $flist != ""} {
817	append flist ",$num"
818	} elseif {$count == 1 && $flist != ""} {
819	append flist ",$lastnum,$num"
820	} elseif {$flist != ""} {
821	append flist "-$lastnum,$num"
822	} else {
823	append flist "$num"
824	}
825	set lastnum $num
826	set count 0
827	} else {
828	incr count
829	incr lastnum
830	}
831	}
832	if {$count == 1 && $flist != ""} {
833	append flist ",$lastnum"
834	} elseif {$flist != "" && $count > 1} {
835	append flist "-$lastnum"
836	}
837	return $flist
838	}
839
840	# Procedure to display Isotropic or Anisotropic temperature factors
841	# Changes the display to one entry widget for Isotropic motion OR
842	# 6 entry widgets for Anisotropic motion in Frame3.
843	# or disables the widet entirly if atom = 0
844	proc DisplayU { atomnum p} {
845	global expgui entryvar entrycmd
846	if {$atomnum == 0} {
847	set iOrA disable
848	} else {
849	set iOrA [atominfo $p $atomnum temptype]
850	}
851
852	set firstbox [lindex $expgui(anisolabels) 0]
853	if { $iOrA == "A" } {
854	$firstbox config -text "U11 "
855	foreach item $expgui(anisolabels) {
856	$item config -fg black
857	}
858	foreach item $expgui(anisoentry) var {U11 U22 U33 U12 U13 U23} {
859	set entrycmd($var) "atominfo $p $atomnum $var"
860	set entryvar($var) [eval $entrycmd($var)]
861	$item config -fg black -state normal -bg white
862	}
863	} elseif { $iOrA == "I" \|\| $iOrA == "disable"} {
864	foreach item $expgui(anisolabels) {
865	# $item config -fg grey
866	$item config -fg beige
867	}
868	foreach item [lrange $expgui(anisoentry) 1 end] \
869	var {U22 U33 U12 U13 U23} {
870	set entrycmd($var) ""
871	set entryvar($var) ""
872	$item config -fg beige -bg beige -state disabled
873	}
874	if { $iOrA == "disable"} {
875	set entrycmd($var) ""
876	set entryvar($var) ""
877	# [lindex $expgui(anisoentry) 0] config -fg white -state disabled
878	[lindex $expgui(anisoentry) 0] config -fg beige -bg beige -state disabled
879	} else {
880	set entrycmd(U11) "atominfo $p $atomnum Uiso"
881	set entryvar(U11) [eval $entrycmd(U11)]
882	$firstbox config -text Uiso -fg black
883	[lindex $expgui(anisoentry) 0] config -fg black -bg white -state normal
884	}
885	}
886	}
887
888	# need to think about multiple phases
889
890	# Procedure to display refinement flags
891	proc DisplayRefFlags { atomnum p} {
892	global expgui entryvar entrycmd
893	if {$atomnum == 0} {
894	foreach label $expgui(atomreflbl) {
895	$label config -fg beige
896	}
897	foreach entry $expgui(atomref) {
898	$entry config -state disabled -fg beige -bg beige
899	}
900	return
901	}
902	foreach label $expgui(atomreflbl) {
903	$label config -fg black
904	}
905	foreach entry $expgui(atomref) {
906	$entry config -state normal -fg black -bg beige
907	}
908	foreach var {xref uref fref xdamp udamp fdamp} {
909	set entrycmd($var) "atominfo $p [list $atomnum] $var"
910	set entryvar($var) [eval $entrycmd($var)]
911	}
912	}
913
914	# Procedure to display an atom in the atom edit boxes
915	proc DisplayAtom { atomnum p} {
916	global expgui entryvar entrycmd
917	if {$atomnum == 0} {
918	foreach label $expgui(atomlabels) {
919	$label config -fg beige
920	}
921	foreach entry $expgui(atomentry) {
922	$entry config -state disabled -fg beige -bg beige
923	}
924	return
925	}
926	foreach label $expgui(atomlabels) {
927	$label config -fg black
928	}
929	foreach entry $expgui(atomentry) {
930	$entry config -state normal -fg black -bg white
931	}
932	foreach var {x y z label frac } {
933	set entrycmd($var) "atominfo $p $atomnum $var"
934	set entryvar($var) [eval $entrycmd($var)]
935	}
936	}
937
938	# update the histogram list
939	# to do: show histogram ref flags?
940	proc sethistlist {} {
941	global expgui expmap
942	foreach lbox $expgui(HistSelectList) {
943	$lbox.title delete 0 end
944	$lbox.lbox delete 0 end
945	if {$expgui(globalmode) != 0} {
946	$lbox.lbox config -selectmode extended
947	} else {
948	$lbox.lbox config -selectmode browse
949	}
950	}
951	# disable the unallowed pages in all mode
952	if {$expgui(globalmode) == 6} {
953	foreach pair $expgui(GlobalModeAllDisable) {
954	if {$expgui(pagenow) == [lindex $pair 0]} {
955	if !$expgui(havetix) {
956	RaisePage lsFrame
957	} else {
958	.n raise lsPane
959	set expgui(pagenow) lsFrame
960	}
961	}
962	eval [lindex $pair 1] -state disabled
963	}
964	} else {
965	foreach pair $expgui(GlobalModeAllDisable) {
966	eval [lindex $pair 1] -state normal
967	}
968	}
969	set histlist {}
970	if {$expgui(hsorttype) == "type"} {
971	# sort on histogram type
972	foreach h [lsort -integer -increasing $expmap(powderlist)] {
973	lappend histlist "$h [string range $expmap(htype_$h) 1 2]"
974	}
975	set expmap(histlistboxcontents) [lsort -ascii -index 1 $histlist]
976	} elseif {$expgui(hsorttype) == "number"} {
977	# sort on histogram number
978	foreach h [lsort -integer -increasing $expmap(powderlist)] {
979	lappend histlist "$h $h"
980	}
981	set expmap(histlistboxcontents) [lsort -integer -index 1 $histlist]
982	} elseif {$expgui(hsorttype) == "bank"} {
983	# sort on original bank number
984	foreach h [lsort -integer -increasing $expmap(powderlist)] {
985	lappend histlist "$h [histinfo $h bank]"
986	}
987	set expmap(histlistboxcontents) [lsort -integer -index 1 $histlist]
988	} elseif {$expgui(hsorttype) == "angle"} {
989	# sort on wavelength (CW) or angle (E disp.)
990	foreach h [lsort -integer -increasing $expmap(powderlist)] {
991	if {[string range $expmap(htype_$h) 2 2] == "T"} {
992	set det [format %8.2f [histinfo $h tofangle]]
993	} elseif {[string range $expmap(htype_$h) 2 2] == "C"} {
994	set det [format %8.5f [histinfo $h lam1]]
995	} elseif {[string range $expmap(htype_$h) 2 2] == "E"} {
996	set det [format %8.2f [histinfo $h lam1]]
997	} else {
998	set det {}
999	}
1000	lappend histlist "$h $det"
1001	}
1002	set expmap(histlistboxcontents) [lsort -real -index 1 $histlist]
1003	}
1004
1005	# title field needs to match longest title
1006	foreach lbox $expgui(HistSelectList) {
1007	$lbox.title insert end [format "%2s %s %4s %8s %-67s" \
1008	"h#" \
1009	type \
1010	bank \
1011	"ang/wave" \
1012	" title" \
1013	]
1014	}
1015	foreach tuple $expmap(histlistboxcontents) {
1016	set h [lindex $tuple 0]
1017
1018	if {$expgui(globalmode) == 1} {
1019	if {[string range $expmap(htype_$h) 2 2] != "T"} continue
1020	} elseif {$expgui(globalmode) == 2} {
1021	if {[string range $expmap(htype_$h) 1 2] != "NC"} continue
1022	} elseif {$expgui(globalmode) == 3} {
1023	if {[string range $expmap(htype_$h) 1 2] != "XC" \|\| \
1024	[histinfo $h lam2] == 0.0} continue
1025	} elseif {$expgui(globalmode) == 4} {
1026	if {[string range $expmap(htype_$h) 1 2] != "XC" \|\| \
1027	[histinfo $h lam2] != 0.0} continue
1028	} elseif {$expgui(globalmode) == 5} {
1029	if {[string range $expmap(htype_$h) 1 2] != "XE"} continue
1030	}
1031
1032	if {[string range $expmap(htype_$h) 2 2] == "T"} {
1033	set det [format %8.2f [histinfo $h tofangle]]
1034	} elseif {[string range $expmap(htype_$h) 2 2] == "C"} {
1035	set det [format %8.5f [histinfo $h lam1]]
1036	} elseif {[string range $expmap(htype_$h) 2 2] == "E"} {
1037	set det [format %8.2f [histinfo $h lam1]]
1038	} else {
1039	set det {}
1040	}
1041	foreach lbox $expgui(HistSelectList) {
1042	$lbox.lbox insert end [format "%2d %s %4d %8s %-67s" \
1043	$h \
1044	[string range $expmap(htype_$h) 1 2] \
1045	[histinfo $h bank] \
1046	$det \
1047	[string range [histinfo $h title] 0 66] \
1048	]
1049	}
1050	}
1051	foreach set $expgui(frameactionlist) {
1052	if {$expgui(pagenow) == [lindex $set 0]} [lindex $set 1]
1053	}
1054	}
1055
1056	#-----------------------------------------------------------------------
1057	# ----------- draw Histogram page
1058	#-----------------------------------------------------------------------
1059	proc DisplayHistogram {} {
1060	global expgui entrycmd entryvar expmap
1061
1062	# display the selected histograms
1063	$expgui(histFrame).hs.lbox selection clear 0 end
1064	foreach h $expgui(curhist) {
1065	$expgui(histFrame).hs.lbox selection set $h
1066	}
1067
1068	# disable traces on entryvar for right now
1069	set entrycmd(trace) 0
1070
1071	# get histogram list
1072	set histlist {}
1073	foreach item $expgui(curhist) {
1074	lappend histlist [lindex $expmap(powderlist) $item]
1075	}
1076	# must have at least one histogram selected here
1077	if {[llength $histlist] == 0} {
1078	set expgui(backtermlbl) ""
1079	set expgui(backtypelbl) ""
1080	foreach var {bref bdamp} {
1081	set entrycmd($var) ""
1082	set entryvar($var) ""
1083	}
1084	$expgui(histFrame).top.txt config -text "No Selected Histograms"
1085	grid $expgui(histFrame).top -column 1 -row 0 -sticky nsew
1086	set expgui(bkglbl) ""
1087	eval destroy [grid slaves $expgui(diffBox)]
1088	set entrycmd(trace) 1
1089	return
1090	}
1091
1092	if {$expgui(globalmode) != 0} {
1093	set expgui(backtermlbl) ""
1094	set expgui(backtypelbl) ""
1095	foreach var {bref bdamp} {
1096	set entrycmd($var) "histinfo [list $histlist] $var"
1097	set entryvar($var) [histinfo [lindex $histlist 0] $var]
1098	}
1099	} else {
1100	set hist $histlist
1101	set terms [histinfo $hist backterms]
1102	set expgui(backtermlbl) "($terms terms)"
1103	set expgui(backtypelbl) "Function type [histinfo $hist backtype]"
1104	foreach var {bref bdamp} {
1105	set entrycmd($var) "histinfo $hist $var"
1106	set entryvar($var) [eval $entrycmd($var)]
1107	}
1108	}
1109	# Top box
1110	if {$expgui(globalmode) != 0} {
1111	$expgui(histFrame).top.txt config \
1112	-text "Selected Histograms: [CompressList $histlist]"
1113	grid $expgui(histFrame).top -column 1 -row 0 -sticky nsew
1114	set expgui(bkglbl) "Globally Edit Background"
1115	} else {
1116	grid forget $expgui(histFrame).top
1117	set expgui(bkglbl) "Edit Background"
1118	}
1119
1120	# diffractometer constants
1121	foreach var {lam1 lam2 kratio pola ipola ddamp zero \
1122	wref pref dcref daref ratref ttref zref } {
1123	set entrycmd($var) "histinfo [list $histlist] $var"
1124	set entryvar($var) [histinfo [lindex $histlist 0] $var]
1125	}
1126
1127	eval destroy [grid slaves $expgui(diffBox)]
1128	if {$expgui(globalmode) == 0} {
1129	if {[string range $expmap(htype_$hist) 2 2] == "T"} {
1130	#------
1131	# TOF \|
1132	#------
1133	grid [ label $expgui(diffBox).lDCrc -text "Refine DIFC" ] \
1134	-column 1 -row 1
1135	grid [ checkbutton $expgui(diffBox).rfDCrc -variable entryvar(dcref) ] \
1136	-column 2 -row 1
1137	grid [ label $expgui(diffBox).lDCdifc -text DIFC ] \
1138	-column 3 -row 1 -sticky w
1139	grid [ entry $expgui(diffBox).eDCdifc -textvariable entryvar(lam1) \
1140	-width 15 ] -column 4 -row 1
1141	#
1142	grid [ label $expgui(diffBox).lDCra -text "Refine DIFA" ] \
1143	-column 1 -row 2
1144	grid [ checkbutton $expgui(diffBox).rfDCra -variable entryvar(daref) ] \
1145	-column 2 -row 2
1146	grid [ label $expgui(diffBox).lDCdifa -text DIFA ] \
1147	-column 3 -row 2
1148	grid [ entry $expgui(diffBox).eDCdifa -textvariable entryvar(lam2) \
1149	-width 15 ] -column 4 -row 2
1150	#
1151	grid [ label $expgui(diffBox).lDCzero -text "Zero"] \
1152	-column 3 -row 3
1153	grid [ entry $expgui(diffBox).eDCzero -textvariable entryvar(zero) \
1154	-width 15 ] -column 4 -row 3
1155	grid [ label $expgui(diffBox).lDCzref -text "Refine zero" ] \
1156	-column 1 -row 3 -sticky w
1157	grid [ checkbutton $expgui(diffBox).rfDCzref \
1158	-variable entryvar(zref) ] -column 2 -row 3
1159	} elseif {[string range $expmap(htype_$hist) 1 2] == "NC"} {
1160	#---------------
1161	# CW - neutron \|
1162	#---------------
1163	grid [ label $expgui(diffBox).lDC1 -text "Refine wave" ] \
1164	-column 1 -row 1
1165	grid [ checkbutton $expgui(diffBox).rfDC1 -variable entryvar(wref) ] \
1166	-column 2 -row 1
1167	grid [ label $expgui(diffBox).lDCdifc -text wave ] \
1168	-column 3 -row 1 -sticky w
1169	grid [ entry $expgui(diffBox).eDCdifc -textvariable entryvar(lam1) \
1170	-width 15 ] -column 4 -row 1
1171	#
1172	grid [ label $expgui(diffBox).lDCzref -text "Refine zero" ] \
1173	-column 1 -row 3 -sticky w
1174	grid [ checkbutton $expgui(diffBox).rfDCzref \
1175	-variable entryvar(zref) ] -column 2 -row 3
1176	grid [ label $expgui(diffBox).lDCzero -text "Zero"] \
1177	-column 3 -row 3
1178	grid [ entry $expgui(diffBox).eDCzero -textvariable entryvar(zero) \
1179	-width 15 ] -column 4 -row 3
1180	} elseif {[string range $expmap(htype_$hist) 1 2] == "XC" && \
1181	[histinfo $hist lam2] == 0.0} {
1182	#--------------------------
1183	# CW - x-ray 1 wavelength \|
1184	#--------------------------
1185	grid [ label $expgui(diffBox).lDC1 -text "Refine wave" ] \
1186	-column 1 -row 1
1187	grid [ checkbutton $expgui(diffBox).rfDC1 -variable entryvar(wref) ] \
1188	-column 2 -row 1
1189	grid [ label $expgui(diffBox).lDCdifc -text wave ] \
1190	-column 3 -row 1 -sticky w
1191	grid [ entry $expgui(diffBox).eDCdifc -textvariable entryvar(lam1) \
1192	-width 15 ] -column 4 -row 1
1193	#
1194	grid [ label $expgui(diffBox).lDCzref -text "Refine zero" ] \
1195	-column 1 -row 3 -sticky w
1196	grid [ checkbutton $expgui(diffBox).rfDCzref \
1197	-variable entryvar(zref) ] -column 2 -row 3
1198	grid [ label $expgui(diffBox).lDCzero -text "Zero"] \
1199	-column 3 -row 3
1200	grid [ entry $expgui(diffBox).eDCzero -textvariable entryvar(zero) \
1201	-width 15 ] -column 4 -row 3
1202	#
1203	grid [ label $expgui(diffBox).lDCpref -text "Refine POLA" ] \
1204	-column 1 -row 4 -sticky w
1205	grid [ checkbutton $expgui(diffBox).rfDCpref \
1206	-variable entryvar(pref) ] -column 2 -row 4
1207	grid [ label $expgui(diffBox).lDCpola -text POLA ] \
1208	-column 3 -row 4
1209	grid [ entry $expgui(diffBox).eDCpola \
1210	-textvariable entryvar(pola) -width 15 ] -column 4 -row 4
1211	grid [ label $expgui(diffBox).lDCipola -text "IPOLA" ] \
1212	-column 5 -row 4
1213	grid [ entry $expgui(diffBox).eDCipola -width 2 \
1214	-textvariable entryvar(ipola)] -column 6 -row 4
1215	} elseif {[string range $expmap(htype_$hist) 1 2] == "XC"} {
1216	#---------------------------
1217	# CW - x-ray 2 wavelengths \|
1218	#---------------------------
1219	grid [ label $expgui(diffBox).lDCdifc -text wavelengths ] \
1220	-column 3 -row 1 -sticky w
1221	grid [ entry $expgui(diffBox).eDCdifc -textvariable entryvar(lam1) \
1222	-width 15 ] -column 4 -row 1
1223	grid [ entry $expgui(diffBox).eDCdifa -textvariable entryvar(lam2) \
1224	-width 15 ] -column 5 -row 1
1225	#
1226	grid [ label $expgui(diffBox).lDCrref -text "Refine ratio" ] \
1227	-column 1 -row 2 -sticky w
1228	grid [ checkbutton $expgui(diffBox).rfDCrref \
1229	-variable entryvar(ratref) ] -column 2 -row 2
1230	grid [ label $expgui(diffBox).lDCratio -text Ratio ] \
1231	-column 3 -row 2
1232	grid [ entry $expgui(diffBox).eDCkratio \
1233	-textvariable entryvar(kratio) \
1234	-width 15 ] -column 4 -row 2
1235	#
1236	grid [ label $expgui(diffBox).lDCzero -text "Zero"] \
1237	-column 3 -row 3
1238	grid [ entry $expgui(diffBox).eDCzero -textvariable entryvar(zero) \
1239	-width 15 ] -column 4 -row 3
1240	grid [ label $expgui(diffBox).lDCzref -text "Refine zero" ] \
1241	-column 1 -row 3 -sticky w
1242	grid [ checkbutton $expgui(diffBox).rfDCzref \
1243	-variable entryvar(zref) ] -column 2 -row 3
1244	grid [ label $expgui(diffBox).lDCpref -text "Refine POLA" ] \
1245	-column 1 -row 4 -sticky w
1246	grid [ checkbutton $expgui(diffBox).rfDCpref \
1247	-variable entryvar(pref) ] -column 2 -row 4
1248	grid [ label $expgui(diffBox).lDCpola -text POLA ] \
1249	-column 3 -row 4
1250	grid [ entry $expgui(diffBox).eDCpola \
1251	-textvariable entryvar(pola) -width 15 ] -column 4 -row 4
1252	grid [ label $expgui(diffBox).lDCipola -text "IPOLA" ] \
1253	-column 5 -row 4
1254	grid [ entry $expgui(diffBox).eDCipola -width 2 \
1255	-textvariable entryvar(ipola)] -column 6 -row 4
1256	} elseif {[string range $expmap(htype_$hist) 1 2] == "XE"} {
1257	#-------------
1258	# ED - x-ray \|
1259	#-------------
1260	grid [ label $expgui(diffBox).lDC1 -text "Refine 2theta" ] \
1261	-column 1 -row 1
1262	grid [ checkbutton $expgui(diffBox).rfDC1 -variable entryvar(ttref) ] \
1263	-column 2 -row 1
1264	grid [ label $expgui(diffBox).lDCdifc -text 2Theta ] \
1265	-column 3 -row 1 -sticky w
1266	grid [ entry $expgui(diffBox).eDCdifc -textvariable entryvar(lam1) \
1267	-width 15 ] -column 4 -row 1
1268	#
1269	grid [ label $expgui(diffBox).lDCpref -text "Refine POLA" ] \
1270	-column 1 -row 4 -sticky w
1271	grid [ checkbutton $expgui(diffBox).rfDCpref \
1272	-variable entryvar(pref) ] -column 2 -row 4
1273	grid [ label $expgui(diffBox).lDCpola -text POLA ] \
1274	-column 3 -row 4
1275	grid [ entry $expgui(diffBox).eDCpola \
1276	-textvariable entryvar(pola) -width 15 ] -column 4 -row 4
1277	grid [ label $expgui(diffBox).lDCipola -text "IPOLA" ] \
1278	-column 5 -row 4
1279	grid [ entry $expgui(diffBox).eDCipola -width 2 \
1280	-textvariable entryvar(ipola)] -column 6 -row 4
1281	}
1282	} elseif {$expgui(globalmode) == 1} {
1283	#-------------
1284	# Global TOF \|
1285	#-------------
1286	grid [ label $expgui(diffBox).lDCrc -text "Refine DIFC" ] \
1287	-column 1 -row 1
1288	grid [ checkbutton $expgui(diffBox).rfDCrc -variable entryvar(dcref) ] \
1289	-column 2 -row 1
1290	grid [button $expgui(diffBox).bDCdifc -text "Set DIFC Globally" \
1291	-command "editglobalparm histinfo difc {DIFC}"] -column 3 -row 1
1292	#
1293	grid [ label $expgui(diffBox).lDCra -text "Refine DIFA" ] \
1294	-column 1 -row 2
1295	grid [ checkbutton $expgui(diffBox).rfDCra -variable entryvar(daref) ] \
1296	-column 2 -row 2
1297	grid [ button $expgui(diffBox).bDCdifa -text "Set DIFA Globally" \
1298	-command "editglobalparm histinfo difa {DIFA}"] -column 3 -row 2
1299	#
1300	grid [ label $expgui(diffBox).lDCzref -text "Refine zero" ] \
1301	-column 1 -row 3 -sticky w
1302	grid [ checkbutton $expgui(diffBox).rfDCzref \
1303	-variable entryvar(zref) ] -column 2 -row 3
1304	grid [ button $expgui(diffBox).bDCzero -text "Set ZERO Globally" \
1305	-command "editglobalparm histinfo zero {Zero}"] -column 3 -row 3
1306	} elseif {$expgui(globalmode) == 2} {
1307	#--------------------
1308	# Global CW neutron \|
1309	#--------------------
1310	grid [ label $expgui(diffBox).lDC1 -text "Refine wave" ] \
1311	-column 1 -row 1
1312	grid [ checkbutton $expgui(diffBox).rfDC1 -variable entryvar(wref) ] \
1313	-column 2 -row 1
1314	grid [button $expgui(diffBox).bDCdifc -text "Set Wave Globally" \
1315	-command "editglobalparm histinfo lam1 Wavelength"] \
1316	-column 3 -row 1
1317	#
1318	grid [ label $expgui(diffBox).lDCzref -text "Refine zero" ] \
1319	-column 1 -row 3 -sticky w
1320	grid [ checkbutton $expgui(diffBox).rfDCzref \
1321	-variable entryvar(zref) ] -column 2 -row 3
1322	grid [button $expgui(diffBox).bDCzero -text "Set Zero Globally" \
1323	-command "editglobalparm histinfo zero Zero"] -column 3 -row 3
1324	} elseif {$expgui(globalmode) == 4} {
1325	#----------------------
1326	# Global CW mono xray \|
1327	#----------------------
1328	grid [ label $expgui(diffBox).lDC1 -text "Refine wave" ] \
1329	-column 1 -row 1
1330	grid [ checkbutton $expgui(diffBox).rfDC1 -variable entryvar(wref) ] \
1331	-column 2 -row 1
1332	grid [button $expgui(diffBox).bDCdifc -text "Set Wave Globally" \
1333	-command "editglobalparm histinfo lam1 Wavelength"] \
1334	-column 3 -row 1
1335	#
1336	grid [ label $expgui(diffBox).lDCzref -text "Refine zero" ] \
1337	-column 1 -row 3 -sticky w
1338	grid [ checkbutton $expgui(diffBox).rfDCzref \
1339	-variable entryvar(zref) ] -column 2 -row 3
1340	grid [button $expgui(diffBox).bDCzero -text "Set Zero Globally" \
1341	-command "editglobalparm histinfo zero Zero"] -column 3 -row 3
1342	#
1343	grid [ label $expgui(diffBox).lDCpref -text "Refine POLA" ] \
1344	-column 1 -row 4 -sticky w
1345	grid [ checkbutton $expgui(diffBox).rfDCpref \
1346	-variable entryvar(pref) ] -column 2 -row 4
1347	grid [button $expgui(diffBox).bDCpola -text "Set POLA Globally" \
1348	-command "editglobalparm histinfo pola POLA"] -column 3 -row 4
1349	grid [button $expgui(diffBox).bDCipola -text "Set IPOLA Globally" \
1350	-command "editglobalparm histinfo ipola IPOLA"] -column 4 -row 4
1351	} elseif {$expgui(globalmode) == 3} {
1352	#------------------------
1353	# Global alpha 1,2 xray \|
1354	#------------------------
1355	grid [button $expgui(diffBox).bDCl1 -text "Set Wave1 Globally" \
1356	-command "editglobalparm histinfo lam1 {Wavelength 1}"] \
1357	-column 3 -row 1
1358	grid [button $expgui(diffBox).bDCl2 -text "Set Wave2 Globally" \
1359	-command "editglobalparm histinfo lam2 {Wavelength 2}"] \
1360	-column 4 -row 1
1361	#
1362	grid [ label $expgui(diffBox).lDCratref -text "Refine Ratio" ] \
1363	-column 1 -row 3 -sticky w
1364	grid [ checkbutton $expgui(diffBox).rfDCratref \
1365	-variable entryvar(ratref) ] -column 2 -row 3
1366	grid [button $expgui(diffBox).bDCrrat -text "Set Ratio Globally" \
1367	-command "editglobalparm histinfo ratio {Wavelength Ratio}"] \
1368	-column 3 -row 3
1369	#
1370	grid [ label $expgui(diffBox).lDCzref -text "Refine zero" ] \
1371	-column 1 -row 3 -sticky w
1372	grid [ checkbutton $expgui(diffBox).rfDCzref \
1373	-variable entryvar(zref) ] -column 2 -row 3
1374	grid [button $expgui(diffBox).bDCzero -text "Set Zero Globally" \
1375	-command "editglobalparm histinfo zero Zero"] -column 3 -row 3
1376	#
1377	grid [ label $expgui(diffBox).lDCpref -text "Refine POLA" ] \
1378	-column 1 -row 4 -sticky w
1379	grid [ checkbutton $expgui(diffBox).rfDCpref \
1380	-variable entryvar(pref) ] -column 2 -row 4
1381	grid [button $expgui(diffBox).bDCpola -text "Set POLA Globally" \
1382	-command "editglobalparm histinfo pola POLA"] -column 3 -row 4
1383	grid [button $expgui(diffBox).bDCipola -text "Set IPOLA Globally" \
1384	-command "editglobalparm histinfo ipola IPOLA"] -column 4 -row 4
1385	} elseif {$expgui(globalmode) == 5} {
1386	#-----------------
1387	# Global ED xray \|
1388	#-----------------
1389	grid [ label $expgui(diffBox).lDC1 -text "Refine 2theta" ] \
1390	-column 1 -row 1
1391	grid [ checkbutton $expgui(diffBox).rfDC1 -variable entryvar(ttref) ] \
1392	-column 2 -row 1
1393	grid [button $expgui(diffBox).bDCdifc -text "Set 2Theta Globally" \
1394	-command "editglobalparm histinfo ratio {Fixed 2Theta}"] \
1395	-column 3 -row 1
1396	#
1397	grid [ label $expgui(diffBox).lDCpref -text "Refine POLA" ] \
1398	-column 1 -row 4 -sticky w
1399	grid [ checkbutton $expgui(diffBox).rfDCpref \
1400	-variable entryvar(pref) ] -column 2 -row 4
1401	grid [button $expgui(diffBox).bDCpola -text "Set POLA Globally" \
1402	-command "editglobalparm histinfo pola POLA"] -column 3 -row 4
1403	grid [button $expgui(diffBox).bDCipola -text "Set IPOLA Globally" \
1404	-command "editglobalparm histinfo ipola IPOLA"] -column 4 -row 4
1405	}
1406	if {$expgui(globalmode) == 0} {
1407	grid [frame $expgui(diffBox).d] -column 5 -row 5 \
1408	-columnspan 2 -sticky e
1409	} else {
1410	grid [frame $expgui(diffBox).d] -column 4 -row 5 \
1411	-columnspan 2 -sticky e
1412	}
1413	grid [label $expgui(diffBox).d.lDamp -text "Damping "] \
1414	-column 1 -row 1
1415	tk_optionMenu $expgui(diffBox).d.om entryvar(ddamp) 0 1 2 3 4 5 6 7 8 9
1416	grid $expgui(diffBox).d.om -column 2 -row 1
1417	grid columnconfigure $expgui(diffBox) 9 -weight 1
1418	grid columnconfigure $expgui(diffBox) 0 -weight 1
1419	update idletasks
1420	# enable traces on entryvar now
1421	set entrycmd(trace) 1
1422	}
1423
1424	#-----------------------------------------------------------------------
1425	# populate the Scaling page
1426	#-----------------------------------------------------------------------
1427	proc DisplayFrac {} {
1428	global expgui entrycmd entryvar expmap
1429
1430	# display the selected histograms
1431	$expgui(fracFrame).hs.lbox selection clear 0 end
1432	foreach h $expgui(curhist) {
1433	$expgui(fracFrame).hs.lbox selection set $h
1434	}
1435
1436	# disable traces on entryvar
1437	set entrycmd(trace) 0
1438
1439	# get histogram list
1440	set histlist {}
1441	foreach item $expgui(curhist) {
1442	lappend histlist [lindex $expmap(powderlist) $item]
1443	}
1444
1445	# must have at least one histogram selected here
1446	if {[llength $histlist] == 0} {
1447	foreach var {scale sref sdamp} {
1448	set entrycmd($var) ""
1449	set entryvar($var) ""
1450	}
1451	set parm [grid info $expgui(scaleBox).but1]
1452	if {$parm != ""} {
1453	grid forget $expgui(scaleBox).but1
1454	eval grid $expgui(scaleBox).ent1 $parm
1455	}
1456	# destroy the contents of the frame
1457	set phaseFractf1 $expgui(FracBox).f
1458	eval destroy [grid slaves $phaseFractf1]
1459	# reenable traces on entryvar
1460	set entrycmd(trace) 1
1461	return
1462	}
1463
1464	#--------------
1465	# Scale factor
1466	#--------------
1467	if {$expgui(globalmode) != 0} {
1468	foreach var {scale sref sdamp} {
1469	set entrycmd($var) "histinfo [list $histlist] $var"
1470	set entryvar($var) [histinfo [lindex $histlist 0] $var]
1471	}
1472	set parm [grid info $expgui(scaleBox).ent1]
1473	if {$parm != ""} {
1474	grid forget $expgui(scaleBox).ent1
1475	eval grid $expgui(scaleBox).but1 $parm
1476	}
1477	} else {
1478	set hist $histlist
1479	foreach var {scale sref sdamp} {
1480	set entrycmd($var) "histinfo $hist $var"
1481	set entryvar($var) [eval $entrycmd($var)]
1482	}
1483	set parm [grid info $expgui(scaleBox).but1]
1484	if {$parm != ""} {
1485	grid forget $expgui(scaleBox).but1
1486	eval grid $expgui(scaleBox).ent1 $parm
1487	}
1488	}
1489
1490	#----------------
1491	# Phase Fractions
1492	#----------------
1493	set phaseFractf1 $expgui(FracBox).f
1494	# destroy the contents of the frame
1495	eval destroy [grid slaves $phaseFractf1]
1496	if {$expgui(globalmode) != 0} {
1497	grid [label $phaseFractf1.txt -anchor center \
1498	-text "Phase Fractions for Histograms: [CompressList $histlist]"] \
1499	-column 0 -row 0 -sticky news
1500	} else {
1501	grid [label $phaseFractf1.txt -anchor center \
1502	-text "Phase Fractions"] -column 0 -row 0 -sticky news
1503	}
1504	# Create the frame inside the canvas, One frame for each Phase.
1505	foreach i {1 2 3 4 5 6 7 8 9} {set phasehistlist($i) ""}
1506	foreach hist $histlist {
1507	foreach i $expmap(phaselist_$hist) {
1508	lappend phasehistlist($i) $hist
1509	}
1510	}
1511	foreach i {1 2 3 4 5 6 7 8 9} {
1512	if {[llength $phasehistlist($i)] == 0} continue
1513	set framePF [frame $phaseFractf1.pF$i -relief groove -bd 4]
1514	grid $framePF -column 0 -row $i -sticky ew
1515	# Label Heading for each phase.
1516	if {$expgui(globalmode) != 0} {
1517	grid [label $framePF.l1 \
1518	-text "Phase $i Hist: [CompressList $phasehistlist($i)] Fraction"] \
1519	-column 0 -row 0 -sticky nws
1520	grid [button $framePF.but1 -text "Set Globally" \
1521	-command "editglobalparm hapinfo frac \"Phase $i Fraction\" \
1522	[list $phasehistlist($i)] $i" \
1523	] -column 1 -row 0
1524	} else {
1525	grid [label $framePF.l1 -text "Phase $i fraction"] \
1526	-column 0 -row 0 -sticky nws
1527	grid [entry $framePF.ent -textvariable entryvar(frac$i) -width 15]\
1528	-column 1 -row 0
1529	}
1530	set entrycmd(frac$i) "hapinfo $hist $i frac"
1531	set entryvar(frac$i) [hapinfo $hist $i frac]
1532	grid [label $framePF.l2 -text " Refine"] \
1533	-column 2 -row 0 -sticky nws
1534	grid [checkbutton $framePF.cb -variable entryvar(frref$i)] \
1535	-column 3 -row 0 -sticky nws
1536	set entrycmd(frref$i) "hapinfo $hist $i frref"
1537	set entryvar(frref$i) [hapinfo $hist $i frref]
1538	grid [label $framePF.l3 -text " Damping"] \
1539	-column 4 -row 0 -sticky nws
1540	tk_optionMenu $framePF.tkOptDamp entryvar(frdamp$i) \
1541	0 1 2 3 4 5 6 7 8 9
1542	set entrycmd(frdamp$i) "hapinfo $hist $i frdamp"
1543	set entryvar(frdamp$i) [hapinfo $hist $i frdamp]
1544	grid $framePF.tkOptDamp -row 0 -sticky nsw -column 5
1545	}
1546	# resize the scroll window to match the actual
1547	update idletasks
1548	$expgui(FracBox) config -scrollregion [grid bbox $expgui(FracBox).f]
1549	$expgui(FracBox) config -width [lindex [grid bbox $expgui(FracBox).f] 2]
1550	update idletasks
1551	# enable traces on entryvar now
1552	set entrycmd(trace) 1
1553	}
1554
1555	#-----------------------------------------------------------------------
1556	# display the profile page
1557	#-----------------------------------------------------------------------
1558	proc DisplayProfile {} {
1559	global expgui entrycmd entryvar expmap
1560	$expgui(profFrame).hs.lbox selection clear 0 end
1561	foreach h $expgui(curhist) {
1562	$expgui(profFrame).hs.lbox selection set $h
1563	}
1564
1565	# destroy the contents of the frame
1566	eval destroy [grid slaves $expgui(ProfileBox).f]
1567
1568	if {$expgui(globalmode) == 0} {
1569	# must have at least one histogram selected here
1570	if {[llength $expgui(curhist)] == 0} return
1571	# disable traces on entryvar for right now
1572	set entrycmd(trace) 0
1573	set hist [lindex $expmap(powderlist) $expgui(curhist)]
1574	# Create one frame for each Phase.
1575	set ind -1
1576	set htype [string range $expmap(htype_$hist) 2 2]
1577	foreach i $expmap(phaselist_$hist) {
1578	incr ind
1579	grid [frame $expgui(ProfileBox).f.$i -relief groove -bd 4] \
1580	-column 0 -row $ind -sticky ew
1581	grid [frame $expgui(ProfileBox).f.$i.1] \
1582	-column 0 -row 0 -columnspan 10 -sticky ew
1583	# Label Heading for each phase.
1584	set ptype [string trim [hapinfo $hist $i proftype]]
1585	pack [label $expgui(ProfileBox).f.$i.1.l \
1586	-text "Phase $i -- type $ptype Damping"]\
1587	-side left
1588	tk_optionMenu $expgui(ProfileBox).f.$i.1.tkOptDamp entryvar(pdamp_$i) \
1589	0 1 2 3 4 5 6 7 8 9
1590	set entrycmd(pdamp_$i) "hapinfo $hist $i pdamp"
1591	set entryvar(pdamp_$i) [hapinfo $hist $i pdamp]
1592	pack $expgui(ProfileBox).f.$i.1.tkOptDamp -side left
1593	pack [label $expgui(ProfileBox).f.$i.1.l1 \
1594	-text " Peak cutoff"]\
1595	-side left
1596	pack [entry $expgui(ProfileBox).f.$i.1.e1 \
1597	-width 10 -textvariable entryvar(pcut_$i)]\
1598	-side left
1599	set entrycmd(pcut_$i) "hapinfo $hist $i pcut"
1600	set entryvar(pcut_$i) [hapinfo $hist $i pcut]
1601
1602	set col -1
1603	set row 1
1604	set nterms [hapinfo $hist $i profterms]
1605	set lbls {}
1606	catch {set lbls $expgui(prof-$htype-$ptype)}
1607	# for type 4, add extra terms depending on the cell type
1608	if {$ptype == 4} {set lbls [type4lbls $lbls $nterms $i]}
1609	for { set num 1 } { $num <= $nterms } { incr num } {
1610	set term {}
1611	catch {set term [lindex $lbls $num]}
1612	if {$term == ""} {set term $num}
1613	incr col
1614	grid [label $expgui(ProfileBox).f.$i.l${num}_${i} -text "$term"] \
1615	-row $row -column $col
1616	incr col
1617	grid [checkbutton $expgui(ProfileBox).f.$i.ref${num}_${i} \
1618	-variable entryvar(pref${num}_$i)] -row $row -column $col
1619	set entrycmd(pref${num}_$i) "hapinfo $hist $i pref$num"
1620	set entryvar(pref${num}_$i) [hapinfo $hist $i pref$num]
1621	incr col
1622	grid [entry $expgui(ProfileBox).f.$i.ent${num}_${i} \
1623	-textvariable entryvar(pterm${num}_$i)\
1624	-width 12] -row $row -column $col
1625	set entrycmd(pterm${num}_$i) "hapinfo $hist $i pterm$num"
1626	set entryvar(pterm${num}_$i) [hapinfo $hist $i pterm$num]
1627	if {$col > 6} {set col -1; incr row}
1628	}
1629	}
1630	grid columnconfigure $expgui(ProfileBox).f 0 -weight 1
1631	} else {
1632	# get histogram list
1633	set histlist {}
1634	foreach item $expgui(curhist) {
1635	lappend histlist [lindex $expmap(powderlist) $item]
1636	}
1637	# must have at least one histogram selected here
1638	if {[llength $histlist] == 0} return
1639	# disable traces on entryvar for right now
1640	set entrycmd(trace) 0
1641	# loop through histograms & phases, set up an array by type
1642	catch {unset ptypearray histarray phasearray}
1643	foreach hist $histlist {
1644	foreach i $expmap(phaselist_$hist) {
1645	set ptype [string trim [hapinfo $hist $i proftype]]
1646	lappend ptypearray(${ptype}_$i) $hist
1647	lappend histarray($ptype) $hist
1648	lappend phasearray($ptype) $i
1649	}
1650	}
1651
1652	set ptype ""
1653	set title ""
1654	set ind -1
1655	foreach key "[lsort [array names ptypearray]] 0_0" {
1656	# split key
1657	scan $key %d_%d type p
1658	# 1st time through
1659	if {$ptype == ""} {set ptype $type}
1660	if {$ptype == $type} {
1661	# we've seen this one before
1662	if {$title != ""} {append title "\n"}
1663	append title "Phase $p, hist [CompressList $ptypearray($key)]"
1664	} else {
1665	set hist [lindex $histarray($ptype) 0]
1666	set phase [lindex $phasearray($ptype) 0]
1667	set nterms [hapinfo $hist $phase profterms]
1668	set htype [string range $expmap(htype_$hist) 2 2]
1669	set lbls $expgui(prof-$htype-$ptype)
1670	set i $ptype
1671	# Create one frame for this type
1672	incr ind
1673	grid [frame $expgui(ProfileBox).f.$i -relief groove -bd 4] \
1674	-column 0 -row $ind -sticky ew
1675	grid [frame $expgui(ProfileBox).f.$i.0] \
1676	-column 0 -row 0 -columnspan 20 -sticky ew
1677	grid [label $expgui(ProfileBox).f.$i.0.0 \
1678	-text "Profile Type $ptype "] -row 0 -column 0
1679	grid [label $expgui(ProfileBox).f.$i.0.1 \
1680	-text $title -anchor w] -row 0 -column 1
1681	grid [frame $expgui(ProfileBox).f.$i.1] \
1682	-column 0 -row 1 -columnspan 20 -sticky ew
1683	grid [label $expgui(ProfileBox).f.$i.1.2 \
1684	-text "Damping"] -row 0 -column 2
1685	tk_optionMenu $expgui(ProfileBox).f.$i.1.tkOptDamp \
1686	entryvar(pdamp_$ptype) 0 1 2 3 4 5 6 7 8 9
1687	set entrycmd(pdamp_$ptype) "hapinfo \
1688	[list $histarray($ptype)] \
1689	[list $phasearray($ptype)] pdamp"
1690	set entryvar(pdamp_$ptype) [hapinfo $hist $phase pdamp]
1691	grid $expgui(ProfileBox).f.$i.1.tkOptDamp -row 0 -column 3
1692	grid [button $expgui(ProfileBox).f.$i.1.edit \
1693	-text "Global Edit" \
1694	-command "EditProfile [list $title] \
1695	[list $histarray($ptype)] [list $phasearray($ptype)] " \
1696	] -row 0 -column 4 -sticky w
1697	# for type 4, add extra terms depending on the cell type
1698	if {$ptype == 4} {set lbls [type4lbls $lbls $nterms $phase]}
1699	set col -1
1700	set row 2
1701	for { set num 1 } { $num <= $nterms } { incr num } {
1702	set term {}
1703	catch {set term [lindex $lbls $num]}
1704	if {$term == ""} {set term $num}
1705	incr col
1706	grid [label $expgui(ProfileBox).f.$i.l${num}_${i} -text "$term"] \
1707	-row $row -column $col
1708	incr col
1709	grid [checkbutton $expgui(ProfileBox).f.$i.ref${num}_${i} \
1710	-variable entryvar(pref${num}_$i)] \
1711	-row $row -column $col
1712	set entrycmd(pref${num}_$i) "hapinfo \
1713	[list $histarray($ptype)] \
1714	[list $phasearray($ptype)] pref$num"
1715	set entryvar(pref${num}_$i) [hapinfo $hist $phase pref$num]
1716	if {$col > 10} {set col -1; incr row}
1717	}
1718	grid columnconfigure $expgui(ProfileBox).f 0 -weight 1
1719	set ptype ""
1720	}
1721	}
1722	}
1723
1724	# resize the scroll window to match the actual
1725	update idletasks
1726	$expgui(ProfileBox) config -scrollregion [grid bbox $expgui(ProfileBox).f]
1727	$expgui(ProfileBox) config -width [lindex [grid bbox $expgui(ProfileBox).f] 2]
1728	update idletasks
1729	# enable traces on entryvar now
1730	set entrycmd(trace) 1
1731	}
1732
1733	# profile labels for type 4 profile
1734	proc type4lbls {lbls nterms phase} {
1735	if {$nterms == 14} {
1736	# cubic
1737	lappend lbls S400 S220
1738	} elseif {$nterms == 15} {
1739	# hexagonal
1740	lappend lbls S400 S004 S202
1741	} elseif {$nterms == 16} {
1742	# tetragonal or rhombohedral
1743	if {[phaseinfo $phase a] == [phaseinfo $phase c]} {
1744	# rhombohedral
1745	lappend lbls S400 S220 S310 S211
1746	} else {
1747	lappend lbls S400 S004 S220 S202
1748	}
1749	} elseif {$nterms == 18} {
1750	# orthorhombic
1751	lappend lbls S400 S040 S004 S220 S202 S022
1752	} elseif {$nterms == 21} {
1753	# monoclinic
1754	lappend lbls S400 S040 S004 S220 S202 S022 S301 S103 S121
1755	} elseif {$nterms == 25} {
1756	# triclinic
1757	lappend lbls S400 S040 S004 S220 S202 S022 S310 S103 S031 \
1758	S130 S301 S013 S211 S121 S112
1759	}
1760	return $lbls
1761	}
1762
1763	# process the bit settings in the print options
1764	# bitnum -- the number of the bit to be tested/set starting at 0 for the LSBit
1765	proc printsetting {bitnum "action get" "value {}"} {
1766	global entryvar expgui
1767	if {$action == "get"} {
1768	return [expr ([expinfo print] & int(pow(2,$bitnum))) != 0]
1769	} elseif $value {
1770	set newval [expr ([expinfo print] \| int(pow(2,$bitnum)))]
1771	} else {
1772	set newval [expr ([expinfo print] & ~int(pow(2,$bitnum)))]
1773	}
1774	expinfo print set $newval
1775	set expgui(printopt) "Print Options ([expinfo print])"
1776	}
1777
1778	# need to respond to mouse presses -- control variable associated with extract Fobs
1779	# and set the LeBail extraction flags
1780	proc SetupExtractHist {} {
1781	global expgui entrycmd entryvar expmap
1782
1783	# display the selected histograms
1784	$expgui(lsFrame).hs.lbox selection clear 0 end
1785	foreach h $expgui(curhist) {
1786	$expgui(lsFrame).hs.lbox selection set $h
1787	}
1788
1789	# get histogram list
1790	set histlist {}
1791	foreach item $expgui(curhist) {
1792	set hist [lindex $expmap(powderlist) $item]
1793	if {$hist != ""} {lappend histlist $hist}
1794	}
1795	set entrycmd(fobsextract) "histinfo [list $histlist] foextract"
1796	if {[llength $histlist] == 0 \|\| [string trim $histlist] == ""} {
1797	foreach phase {1 2 3 4 5 6 7 8 9} {
1798	$expgui(lsFrame).f1.a.l$phase config -fg grey
1799	set expgui(Fextract$phase) {}
1800	foreach item $expgui(ExtractSettingsRadiobuttons) {
1801	${item}$phase config -state disabled -bd 1
1802	}
1803	}
1804	} elseif {[llength $histlist] == 1} {
1805	# disable traces on entryvar
1806	set entrycmd(trace) 0
1807	set entryvar(fobsextract) [histinfo $histlist foextract]
1808	foreach phase {1 2 3 4 5 6 7 8 9} {
1809	# is the phase present?
1810	if {[lsearch -exact $expmap(phaselist_$histlist) $phase] == -1} {
1811	$expgui(lsFrame).f1.a.l$phase config -fg grey
1812	set expgui(Fextract$phase) {}
1813	foreach item $expgui(ExtractSettingsRadiobuttons) {
1814	${item}$phase config -state disabled -bd 1
1815	}
1816	} else {
1817	$expgui(lsFrame).f1.a.l$phase config -fg black
1818	foreach item $expgui(ExtractSettingsRadiobuttons) {
1819	${item}$phase config -state normal -bd 2
1820	}
1821	set expgui(Fextract$phase) [hapinfo $histlist $phase extmeth]
1822	}
1823	}
1824	} elseif {[llength $histlist] > 1} {
1825	# disable traces on entryvar
1826	set entrycmd(trace) 0
1827	# multiple histograms need phases in any histogram
1828	foreach phase {1 2 3 4 5 6 7 8 9} {
1829	set gotphase($phase) 0
1830	}
1831	foreach hist $histlist {
1832	foreach phase $expmap(phaselist_$hist) {
1833	set gotphase($phase) 1
1834	}
1835	}
1836	foreach phase {1 2 3 4 5 6 7 8 9} {
1837	set expgui(Fextract$phase) {}
1838	if $gotphase($phase) {
1839	$expgui(lsFrame).f1.a.l$phase config -fg black
1840	foreach item $expgui(ExtractSettingsRadiobuttons) {
1841	${item}$phase config -state normal -bd 2
1842	}
1843	} else {
1844	$expgui(lsFrame).f1.a.l$phase config -fg grey
1845	foreach item $expgui(ExtractSettingsRadiobuttons) {
1846	${item}$phase config -state disabled -bd 1
1847	}
1848	}
1849	}
1850	}
1851	# reenable traces
1852	set entrycmd(trace) 1
1853	}
1854	# respond to a change in the fobs extraction method for a phase
1855	# force the main extraction flag on, if fobs extraction is selected for any phase
1856	proc HistExtractSet {phase} {
1857	global expgui entryvar expmap
1858	foreach item $expgui(curhist) {
1859	lappend histlist [lindex $expmap(powderlist) $item]
1860	}
1861	hapinfo $histlist $phase extmeth set $expgui(Fextract$phase)
1862	incr expgui(changed)
1863	if {$expgui(Fextract$phase) != 0} {set entryvar(fobsextract) 1}
1864	}
1865	#---------------------------- Global Edit Functions ------------------------
1866	proc editbackground {} {
1867	global expgui expmap entrycmd
1868	set histlist {}
1869	foreach n $expgui(curhist) {
1870	lappend histlist [lindex $expmap(powderlist) $n]
1871	}
1872	if {[llength $histlist] == 0} return
1873
1874	set w .back
1875	catch {destroy $w}
1876	toplevel $w -bg beige
1877	if {$expgui(globalmode) != 0} {
1878	wm title $w "Edit Background"
1879	} else {
1880	wm title $w "Global Edit Background"
1881	}
1882
1883	pack [frame $w.0 -bd 6 -relief groove -bg beige \
1884	] -side top -expand yes -fill both
1885	if {[llength $histlist] > 1} {
1886	grid [label $w.0.a \
1887	-text "Setting background terms for histograms [CompressList $histlist]" \
1888	-bg beige] -row 0 -column 0 -columnspan 10
1889	} else {
1890	grid [label $w.0.a \
1891	-text "Setting background terms for histogram $histlist" \
1892	-bg beige] -row 0 -column 0 -columnspan 10
1893	}
1894	set hist [lindex $histlist 0]
1895	grid [label $w.0.b -text "Function type" -bg beige] -row 1 -column 0
1896
1897	# disable traces on expgui(backtype) & expgui(backterms) now
1898	set entrycmd(trace) 0
1899
1900	# number of terms
1901	set expgui(backtype) [histinfo $hist backtype]
1902	set expgui(orig_backtype) $expgui(backtype)
1903	set expgui(prev_backtype) $expgui(backtype)
1904	eval tk_optionMenu $w.0.type expgui(backtype) {1 2 3 4 5 6}
1905	grid $w.0.type -row 1 -column 1
1906	grid [label $w.0.c -text " Number of terms" -bg beige] -row 1 -column 2
1907
1908	# function type
1909	set expgui(backterms) [histinfo $hist backterms]
1910	set expgui(orig_backterms) $expgui(backterms)
1911	set list {}; for {set i 1} {$i <= 36} {incr i} {lappend list $i}
1912	eval tk_optionMenu $w.0.terms expgui(backterms) $list
1913	grid $w.0.terms -row 1 -column 3
1914	# enable traces on expgui(backtype) & expgui(backterms) now
1915	set entrycmd(trace) 1
1916
1917	#set background terms
1918	for {set num 1 } { $num <= 36 } { incr num } {
1919	set var "bterm$num"
1920	set expgui($var) {}
1921	set expgui(orig_$var) {}
1922	}
1923	if {[llength $histlist] == 1} {
1924	for {set num 1 } { $num <= $expgui(backterms) } { incr num } {
1925	set var "bterm$num"
1926	set expgui($var) [histinfo $histlist $var]
1927	set expgui(orig_$var) $expgui($var)
1928	}
1929	}
1930
1931	pack [frame $w.1 -bd 6 -relief groove -bg beige] -side top \
1932	-expand yes -fill both
1933	ShowBackTerms $w.1
1934
1935	set expgui(temp) {}
1936	pack [frame $w.b] -side top
1937	pack [button $w.b.2 -text Set -command "destroy $w"] -side left
1938	pack [button $w.b.3 -text Quit \
1939	-command "QuitEditBackground $w"] -side left
1940	# force the window to stay on top
1941	wm transient $w [winfo toplevel [winfo parent $w]]
1942
1943	bind $w <Return> "destroy $w"
1944	wm withdraw $w
1945	update idletasks
1946	# center the new window in the middle of the parent
1947	set x [expr [winfo x [winfo parent $w]] + [winfo width .]/2 - \
1948	[winfo reqwidth $w]/2 - [winfo vrootx [winfo parent $w]]]
1949	set y [expr [winfo y [winfo parent $w]] + [winfo height .]/2 - \
1950	[winfo reqheight $w]/2 - [winfo vrooty [winfo parent $w]]]
1951	wm geom $w +$x+$y
1952	wm deiconify $w
1953
1954	set oldFocus [focus]
1955	set oldGrab [grab current $w]
1956	if {$oldGrab != ""} {
1957	set grabStatus [grab status $oldGrab]
1958	}
1959	grab $w
1960	focus $w.b.2
1961	tkwait window $w
1962
1963	catch {focus $oldFocus}
1964	if {$oldGrab != ""} {
1965	if {$grabStatus == "global"} {
1966	grab -global $oldGrab
1967	} else {
1968	grab $oldGrab
1969	}
1970	}
1971	if {$expgui(temp) != ""} return
1972
1973	if {$expgui(orig_backtype) != $expgui(backtype)} {
1974	histinfo $histlist backtype set $expgui(backtype)
1975	incr expgui(changed)
1976	}
1977	if {$expgui(orig_backterms) != $expgui(backterms)} {
1978	histinfo $histlist backterms set $expgui(backterms)
1979	incr expgui(changed)
1980	}
1981	for {set num 1 } { $num <= $expgui(backterms) } { incr num } {
1982	set var "bterm$num"
1983	if {$expgui(orig_$var) != $expgui($var)} {
1984	histinfo $histlist $var set $expgui($var)
1985	incr expgui(changed)
1986	}
1987	}
1988
1989	if {$expgui(globalmode) == 0} {
1990	set expgui(backtypelbl) "Function type [histinfo $hist backtype]"
1991	set expgui(backtermlbl) "([histinfo $hist backterms] terms)"
1992	}
1993	}
1994
1995	trace variable expgui(backterms) w ChangeBackTerms
1996	proc ChangeBackTerms {a b c} {
1997	global entrycmd expgui
1998	if !$entrycmd(trace) return
1999	ShowBackTerms .back.1
2000	}
2001
2002	trace variable expgui(backtype) w ChangeBackType
2003	# reset the terms to 1, 0, 0... when the number of terms increase
2004	proc ChangeBackType {a b c} {
2005	global entrycmd expgui
2006	if !$entrycmd(trace) return
2007	if {$expgui(prev_backtype) == $expgui(backtype)} return
2008	set expgui(prev_backtype) $expgui(backtype)
2009	for {set num 1 } { $num <= $expgui(backterms) } { incr num } {
2010	set var "bterm$num"
2011	if {$num == 1} {
2012	set expgui($var) 1.0
2013	} else {
2014	set expgui($var) 0.0
2015	}
2016	}
2017	}
2018
2019	proc ShowBackTerms {w } {
2020	global expgui expmap
2021	# destroy the contents of the frame
2022	eval destroy [grid slaves $w]
2023	set histlist {}
2024	foreach n $expgui(curhist) {
2025	lappend histlist [lindex $expmap(powderlist) $n]
2026	}
2027	set widgetsPerRow 4
2028	for {set rows 2; set num 1 } { $num <= $expgui(backterms) } { incr rows } {
2029	for {set cols 0} { (2*$widgetsPerRow > $cols) && ($num <= $expgui(backterms)) } { incr num } {
2030	set var "bterm$num"
2031	grid [label $w.l$num -text $num -bg beige] \
2032	-row $rows -column $cols -sticky nes
2033	incr cols
2034	grid [entry $w.e$num -width 15 -textvariable expgui($var) \
2035	] -row $rows -column $cols -sticky news
2036	incr cols
2037	}
2038	}
2039	}
2040
2041	proc QuitEditBackground {w} {
2042	global expgui
2043	# lets find out if anything changed
2044	set changed 0
2045	if {$expgui(orig_backtype) != $expgui(backtype)} {
2046	set changed 1
2047	}
2048	if {$expgui(orig_backterms) != $expgui(backterms)} {
2049	set changed 1
2050	}
2051	for {set num 1 } { $num <= $expgui(backterms) } { incr num } {
2052	set var "bterm$num"
2053	if {$expgui(orig_$var) != $expgui($var)} {
2054	set changed 1
2055	break
2056	}
2057	}
2058	if $changed {
2059	set decision [tk_dialog .changes "Abandon Changes" \
2060	"You have made changes to the background. Ok to abandon changes?" \
2061	warning 0 Abandon Keep]
2062	if !$decision {
2063	set expgui(temp) "Quit"
2064	destroy $w
2065	}
2066	} else {
2067	set expgui(temp) "Quit"
2068	destroy $w
2069	}
2070	}
2071
2072	# this probably needs work
2073	proc editglobalparm {cmd variable title "histlist {}" "phase {}"} {
2074	global expgui expmap
2075	set w .global
2076	catch {destroy $w}
2077	toplevel $w -bg beige
2078	wm title $w "Edit Global Parameter"
2079	set expgui(temp) {}
2080	if {[llength $histlist] == 0} {
2081	set hist {}
2082	foreach n $expgui(curhist) {
2083	lappend hist [lindex $expmap(powderlist) $n]
2084	}
2085	} else {
2086	set hist $histlist
2087	}
2088	pack [frame $w.0 -bd 6 -relief groove -bg beige] \
2089	-side top -expand yes -fill both
2090	grid [label $w.0.a -text "Setting $title for histograms [CompressList $hist]"\
2091	-bg beige] \
2092	-row 0 -column 0 -columnspan 10
2093	grid [entry $w.0.b -textvariable expgui(temp)] \
2094	-row 1 -column 0
2095
2096
2097	pack [frame $w.b] -side top
2098	pack [button $w.b.2 -text Set -command "destroy $w"] -side left
2099	pack [button $w.b.3 -text Quit -command "set expgui(temp) {}; destroy $w"] -side left
2100	# force the window to stay on top
2101	wm transient $w [winfo toplevel [winfo parent $w]]
2102
2103	bind $w <Return> "destroy $w"
2104	wm withdraw $w
2105	update idletasks
2106	# center the new window in the middle of the parent
2107	set x [expr [winfo x [winfo parent $w]] + [winfo width .]/2 - \
2108	[winfo reqwidth $w]/2 - [winfo vrootx [winfo parent $w]]]
2109	set y [expr [winfo y [winfo parent $w]] + [winfo height .]/2 - \
2110	[winfo reqheight $w]/2 - [winfo vrooty [winfo parent $w]]]
2111	wm geom $w +$x+$y
2112	wm deiconify $w
2113
2114	set oldFocus [focus]
2115	set oldGrab [grab current $w]
2116	if {$oldGrab != ""} {
2117	set grabStatus [grab status $oldGrab]
2118	}
2119	grab $w
2120	focus $w.b.2
2121	tkwait window $w
2122	if {$expgui(temp) != ""} {
2123	foreach h $hist {
2124	if {$cmd == "histinfo"} {
2125	histinfo $h $variable set $expgui(temp)
2126	incr expgui(changed)
2127	if $expgui(debug) {
2128	puts "histinfo $h $variable set $expgui(temp)"
2129	}
2130	} elseif {$cmd == "hapinfo"} {
2131	hapinfo $h $phase $variable set $expgui(temp)
2132	incr expgui(changed)
2133	if $expgui(debug) {
2134	puts "hapinfo $phase $h $variable set $expgui(temp)"
2135	}
2136	} else {
2137	error "$cmd unimplemented"
2138	}
2139	}
2140	}
2141	catch {focus $oldFocus}
2142	if {$oldGrab != ""} {
2143	if {$grabStatus == "global"} {
2144	grab -global $oldGrab
2145	} else {
2146	grab $oldGrab
2147	}
2148	}
2149	}
2150
2151	proc EditProfile {title histlist phaselist} {
2152	global expgui expmap entrycmd
2153	set w .back
2154	catch {destroy $w}
2155	toplevel $w -bg beige
2156	wm title $w "Global Edit Profile"
2157	set hist [lindex $histlist 0]
2158	set phase [lindex $phaselist 0]
2159	set ptype [string trim [hapinfo $hist $phase proftype]]
2160	set htype [string range $expmap(htype_$hist) 2 2]
2161	set nterms [hapinfo $hist $phase profterms]
2162
2163	pack [frame $w.0 -bd 6 -relief groove -bg beige \
2164	] -side top -expand yes -fill both
2165	grid [label $w.0.a \
2166	-text "Setting profile terms: $title" \
2167	-bg beige] -row 0 -column 0 -columnspan 10
2168	grid [label $w.0.b -text "Function type $ptype" -bg beige] -row 1 -column 0
2169
2170	# number of terms
2171	# set expgui(backtype) [histinfo $hist backtype]
2172	# set expgui(orig_backtype) $expgui(backtype)
2173	# set expgui(prev_backtype) $expgui(backtype)
2174	# eval tk_optionMenu $w.0.type expgui(backtype) {1 2 3 4 5 6}
2175	# grid $w.0.type -row 1 -column 1
2176
2177	grid [label $w.0.c -text " Peak cutoff" -bg beige] -row 1 -column 3
2178	grid [entry $w.0.d -width 10 ] -row 1 -column 4
2179	set entrylist {}
2180	lappend entrylist "pcut $w.0.d"
2181
2182	set col -1
2183	set row 1
2184	set lbls $expgui(prof-$htype-$ptype)
2185	# for type 4, add extra terms depending on the cell type
2186	if {$ptype == 4} {set lbls [type4lbls $lbls $nterms $i]}
2187	pack [frame $w.1 -bd 6 -relief groove -bg beige \
2188	] -side top -expand yes -fill both
2189	for { set num 1 } { $num <= $nterms } { incr num } {
2190	set term {}
2191	catch {set term [lindex $lbls $num]}
2192	if {$term == ""} {set term $num}
2193	incr col
2194	grid [label $w.1.l${num} -text "$term" -bg beige] \
2195	-row $row -column $col
2196	incr col
2197	grid [entry $w.1.ent${num} \
2198	-width 14] -row $row -column $col
2199	lappend entrylist "pterm$num $w.1.ent${num}"
2200	if {$col > 6} {set col -1; incr row}
2201	}
2202	pack [frame $w.b] -side top
2203	pack [button $w.b.2 -text Set \
2204	-command "SetEditProfile [list $entrylist] [list $phaselist] \
2205	[list $histlist] $w"] -side left
2206	pack [button $w.b.3 -text Quit \
2207	-command "QuitEditProfile $w [list $entrylist]"] -side left
2208	# force the window to stay on top
2209	wm transient $w [winfo toplevel [winfo parent $w]]
2210
2211	bind $w <Return> "destroy $w"
2212	wm withdraw $w
2213	update idletasks
2214	# center the new window in the middle of the parent
2215	set x [expr [winfo x [winfo parent $w]] + [winfo width .]/2 - \
2216	[winfo reqwidth $w]/2 - [winfo vrootx [winfo parent $w]]]
2217	set y [expr [winfo y [winfo parent $w]] + [winfo height .]/2 - \
2218	[winfo reqheight $w]/2 - [winfo vrooty [winfo parent $w]]]
2219	wm geom $w +$x+$y
2220	wm deiconify $w
2221
2222	set oldFocus [focus]
2223	set oldGrab [grab current $w]
2224	if {$oldGrab != ""} {
2225	set grabStatus [grab status $oldGrab]
2226	}
2227	grab $w
2228	focus $w.b.2
2229	tkwait window $w
2230
2231	catch {focus $oldFocus}
2232	if {$oldGrab != ""} {
2233	if {$grabStatus == "global"} {
2234	grab -global $oldGrab
2235	} else {
2236	grab $oldGrab
2237	}
2238	}
2239	}
2240
2241	proc SetEditProfile {entrylist phaselist histlist w} {
2242	global expgui
2243	foreach item $entrylist {
2244	set value [ [lindex $item 1] get ]
2245	if {$value != ""} {
2246	hapinfo $histlist $phaselist [lindex $item 0] set $value
2247	incr expgui(changed)
2248	if $expgui(debug) {
2249	puts "hapinfo [list $phaselist] [list $histlist] [lindex $item 0] set $value"
2250	}
2251	}
2252	}
2253	destroy $w
2254	}
2255
2256	proc QuitEditProfile {w entrylist} {
2257	global expgui
2258	# lets find out if anything changed
2259	set changed 0
2260	foreach item $entrylist {
2261	if {[ [lindex $item 1] get ] != ""} {set changed 1; break}
2262	}
2263	if $changed {
2264	set decision [tk_dialog .changes "Abandon Changes" \
2265	"You have made changes to the Profile. Ok to abandon changes?" \
2266	warning 0 Abandon Keep]
2267	if !$decision {destroy $w}
2268	} else {
2269	destroy $w
2270	}
2271	}
2272
2273	##############################################################################
2274	## #############################################
2275	## END OF THE PROCEDURES SECTION #############################################
2276	## #############################################
2277	##############################################################################
2278
2279	# <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
2280	# <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< <<<<<<<<<<<<<<<<<<<
2281	# <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< BEGIN: GUI SECTION >>>>>>>>>>>>>>>>>>>
2282	# >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> >>>>>>>>>>>>>>>>>>>
2283	# >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
2284	# A frame for menu items at top of display
2285	set expgui(fm) [frame .fm -relief raised -borderwidth 2 -width 150 -height 40]
2286	# Pack the menu frame.
2287	pack $expgui(fm) -fill x -side top -anchor n
2288
2289	# create a button bar
2290	pack [frame .bar -relief raised -bd 2 -bg beige] -fill x -side top -anchor n
2291
2292	# Creating the notebook with 5 panes: Phase, Histogram, Scaling, Profile
2293	# & LS controls
2294	if $expgui(havetix) {
2295	pack [tixNoteBook .n] -expand yes -fill both
2296	.n add lsPane -label "LS Controls" -underline 0
2297	.n pageconfigure lsPane -raisecmd \
2298	"set expgui(pagenow) lsFrame; SetupExtractHist"
2299	lappend expgui(frameactionlist) "lsFrame SetupExtractHist"
2300	.n add phasePane -label "Phase" -underline 0
2301	.n pageconfigure phasePane -raisecmd \
2302	"set expgui(pagenow) phaseFrame; DisplayAllAtoms noreset"
2303	# lappend expgui(frameactionlist) "phaseFrame {DisplayAllAtoms noreset}"
2304	.n add histPane -label "Histogram" -underline 0
2305	.n pageconfigure histPane -raisecmd \
2306	"set expgui(pagenow) histFrame; DisplayHistogram"
2307	lappend expgui(frameactionlist) "histFrame DisplayHistogram"
2308	lappend expgui(GlobalModeAllDisable) "histFrame {.n pageconfigure histPane}"
2309	.n add fracPane -label "Scaling" -underline 6
2310	.n pageconfigure fracPane -raisecmd \
2311	"set expgui(pagenow) fracFrame; DisplayFrac"
2312	lappend expgui(frameactionlist) "fracFrame DisplayFrac"
2313	.n add profPane -label Profile -underline 1
2314	.n pageconfigure profPane -raisecmd \
2315	"set expgui(pagenow) profFrame; DisplayProfile"
2316	lappend expgui(frameactionlist) "profFrame DisplayProfile"
2317	lappend expgui(GlobalModeAllDisable) "profFrame {.n pageconfigure profPane}"
2318	# Finding the pathname to the subwidget frames.
2319	set expgui(phaseFrame) [.n subwidget phasePane]
2320	set expgui(histFrame) [.n subwidget histPane]
2321	set expgui(fracFrame) [.n subwidget fracPane]
2322	set expgui(profFrame) [.n subwidget profPane]
2323	set expgui(lsFrame) [.n subwidget lsPane]
2324	} else {
2325	pack [frame .frmbar] -side top -anchor w
2326	pack [frame .n] -anchor w -fill both -expand yes
2327	foreach item {lsFrame phaseFrame histFrame fracFrame profFrame} \
2328	page {"LS Controls" Phase Histogram Scaling Profile } {
2329	pack [button .frmbar.$item -text $page -bd 2 \
2330	-command "RaisePage $item"] -side left
2331	set expgui($item) [frame .n.$item -relief flat]
2332	}
2333	lappend expgui(frameactionlist) "lsFrame SetupExtractHist"
2334	lappend expgui(frameactionlist) "phaseFrame {DisplayAllAtoms noreset}"
2335	lappend expgui(frameactionlist) "histFrame DisplayHistogram"
2336	lappend expgui(frameactionlist) "fracFrame DisplayFrac"
2337	lappend expgui(frameactionlist) "profFrame DisplayProfile"
2338	lappend expgui(GlobalModeAllDisable) "histFrame {.frmbar.histFrame config}"
2339	lappend expgui(GlobalModeAllDisable) "profFrame {.frmbar.profFrame config}"
2340	}
2341
2342	# this is used in the non-tix notebook to bring up the selected frame
2343	proc RaisePage {nextpage} {
2344	global expgui
2345	set expgui(pagenow) $nextpage
2346	foreach item {phaseFrame histFrame fracFrame profFrame lsFrame} {
2347	if {$item == $nextpage} {
2348	.frmbar.$item config -relief flat
2349	} else {
2350	.frmbar.$item config -relief raised
2351	}
2352	}
2353	# forget all other pages
2354	foreach child [pack slaves .n] {
2355	pack forget $child
2356	}
2357	pack .n.$nextpage -anchor w -fill both -expand yes
2358	foreach set $expgui(frameactionlist) {
2359	if {$expgui(pagenow) == [lindex $set 0]} [lindex $set 1]
2360	}
2361	}
2362	#----------------------------------------------------------------------------
2363	#\/ \/ \/ \/ \/ \/ \/ BEGINNING OF PHASE PANE CODE \/ \/ \/ \/ \/ \/ \/ \/ \/
2364	# Setup major frames here
2365	frame $expgui(phaseFrame).top
2366	set frameLatt [frame $expgui(phaseFrame).frameLatt]
2367	# This is a big frame in the Phase notebook pane to hold a list of CRS data.
2368	set fbig [frame $expgui(phaseFrame).fbig -width 180 -relief raised -borderwidth 4 -bg beige]
2369	# This is a frame just below the big frame: fbig to allow edit of CRS data, One record at a time.
2370	set frame3 [frame $expgui(phaseFrame).frame3 -width 100 -relief raised -borderwidth 4 -bg beige]
2371
2372	grid $expgui(phaseFrame).top -sticky news -row 0 -column 0
2373	grid $frameLatt -sticky news -row 2 -column 0
2374	grid $fbig -sticky news -row 3 -column 0
2375	# give extra space to the atoms box
2376	grid columnconfigure $expgui(phaseFrame) 0 -weight 1
2377	grid rowconfigure $expgui(phaseFrame) 3 -weight 1
2378	grid $frame3 -sticky news -row 4 -column 0
2379	grid columnconfigure $expgui(phaseFrame) 0 -weight 1
2380	grid rowconfigure $expgui(phaseFrame) 3 -weight 1
2381	grid [frame $expgui(phaseFrame).top.ps] -column 0 -row 0 -sticky w
2382	# this is where the buttons will go
2383	pack [label $expgui(phaseFrame).top.ps.0 -text "Phases: "] -side left
2384
2385	grid [label $expgui(phaseFrame).top.lA -text " Phase name:" \
2386	-fg blue ] -column 1 -row 0 -sticky e
2387	grid [entry $expgui(phaseFrame).top.lB -textvariable entryvar(phasename) \
2388	-fg blue -width 45] -column 2 -row 0 -sticky e
2389	grid columnconfigure $expgui(phaseFrame).top 1 -weight 1
2390	# ------------- Lattice Parameter Box ------------------
2391	set e1 [entry $frameLatt.e1 -textvariable entryvar(a) -width 10]
2392	set e2 [entry $frameLatt.e2 -textvariable entryvar(b) -width 10]
2393	set e3 [entry $frameLatt.e3 -textvariable entryvar(c) -width 10]
2394	set e4 [entry $frameLatt.e4 -textvariable entryvar(alpha) -width 10]
2395	set e5 [entry $frameLatt.e5 -textvariable entryvar(beta) -width 10]
2396	set e6 [entry $frameLatt.e6 -textvariable entryvar(gamma) -width 10]
2397	set l1 [label $frameLatt.l1 -text "a"]
2398	set l2 [label $frameLatt.l2 -text "b"]
2399	set l3 [label $frameLatt.l3 -text "c"]
2400	set l4 [label $frameLatt.l4 -text "alpha"]
2401	set l5 [label $frameLatt.l5 -text "beta"]
2402	set l6 [label $frameLatt.l6 -text "gamma"]
2403	grid $e1 -column 1 -row 0 -padx 5
2404	grid $e2 -column 3 -row 0 -padx 5
2405	grid $e3 -column 5 -row 0 -padx 5
2406	grid $e4 -column 1 -row 1 -padx 5
2407	grid $e5 -column 3 -row 1 -padx 5
2408	grid $e6 -column 5 -row 1 -padx 5
2409	grid $l1 -column 0 -row 0 -padx 5 -sticky e
2410	grid $l2 -column 2 -row 0 -padx 5 -sticky e
2411	grid $l3 -column 4 -row 0 -padx 5 -sticky e
2412	grid $l4 -column 0 -row 1 -padx 5 -sticky e
2413	grid $l5 -column 2 -row 1 -padx 5 -sticky e
2414	grid $l6 -column 4 -row 1 -padx 5 -sticky e
2415
2416	grid [label $frameLatt.lr -text "Refine Cell"] -column 6 -row 0 -padx 5 -sticky e
2417	grid [label $frameLatt.ld -text "Cell damping"] -column 6 -row 1 -padx 5 -sticky e
2418	set cFlag [checkbutton $frameLatt.c -text "" -variable entryvar(cellref)]
2419	grid $cFlag -column 7 -row 0 -padx 5 -sticky e
2420	tk_optionMenu $frameLatt.om entryvar(celldamp) 0 1 2 3 4 5 6 7 8 9
2421	grid $frameLatt.om -column 7 -row 1 -padx 5 -sticky e
2422
2423	#-------------- Begin Atom Coordinates Box ---------------------------------
2424	grid [listbox $fbig.title -height 1 -relief flat] \
2425	-row 0 -column 0 -sticky ew
2426	set expgui(atomtitle) $fbig.title
2427	$expgui(atomtitle) configure -font $expgui(coordfont) -selectmode extended
2428	grid [listbox $fbig.lbox -height 10 \
2429	-xscrollcommand " $fbig.bscr set"\
2430	-yscrollcommand " $fbig.rscr set"\
2431	] -row 1 -column 0 -sticky news
2432	set expgui(atomlistbox) $fbig.lbox
2433	$expgui(atomlistbox) configure -font $expgui(coordfont) -selectmode extended
2434	grid [scrollbar $fbig.bscr -orient horizontal \
2435	-command "move2boxes \" $fbig.title $fbig.lbox \" "
2436	] -row 2 -column 0 -sticky ew
2437	grid [scrollbar $fbig.rscr -command "$fbig.lbox yview" \
2438	] -row 1 -column 1 -sticky ns
2439	# give extra space to the atoms box
2440	grid columnconfigure $fbig 0 -weight 1
2441	grid rowconfigure $fbig 1 -weight 1
2442
2443	proc move2boxes {boxlist args} {
2444	foreach listbox $boxlist {
2445	eval $listbox xview $args
2446	}
2447	}
2448	# BIND mouse in editbox
2449	bind $expgui(atomlistbox) <ButtonRelease-1> editRecord
2450	bind $expgui(atomlistbox) <Button-3> SelectAllAtoms
2451
2452	#-------------- End Atoms Section ---------------------------------
2453
2454	# --------------------------- Begin Edit Box -------------------------------
2455	grid [set expgui(EditingAtoms) [label $frame3.top -bg beige -fg blue]] \
2456	-column 0 -row 0 -padx 2 -pady 3 -columnspan 12 -sticky w
2457
2458	set f3l1 [label $frame3.l1 -text "Refinement Flags " -bg beige]
2459	grid $f3l1 -column 0 -row 1 -padx 2 -sticky nsw -pady 3
2460
2461	set f3cFlag1 [checkbutton $frame3.cf1 -text "X" -variable entryvar(xref) -bg beige]
2462	set f3cFlag2 [checkbutton $frame3.cf2 -text "U" -variable entryvar(uref) -bg beige]
2463	set f3cFlag3 [checkbutton $frame3.cf3 -text "F" -variable entryvar(fref) -bg beige]
2464	grid $f3cFlag1 -column 1 -row 1 -padx 2 -pady 3 -sticky w
2465	grid $f3cFlag2 -column 2 -row 1 -padx 2 -pady 3 -sticky w
2466	grid $f3cFlag3 -column 3 -row 1 -padx 2 -pady 3 -sticky w
2467
2468	set f3l4 [label $frame3.l4 -text "Damping Factors " -bg beige]
2469	grid $f3l4 -column 4 -row 1 -padx 2 -sticky nsw -pady 3
2470
2471	tk_optionMenu $frame3.om2 entryvar(xdamp) 0 1 2 3 4 5 6 7 8 9
2472	tk_optionMenu $frame3.om3 entryvar(udamp) 0 1 2 3 4 5 6 7 8 9
2473	tk_optionMenu $frame3.om4 entryvar(fdamp) 0 1 2 3 4 5 6 7 8 9
2474	grid [label $frame3.lom2 -text X -bg beige] -column 5 -row 1 -padx 2 -pady 3 -sticky w
2475	grid $frame3.om2 -column 6 -row 1 -padx 2 -pady 3 -sticky w
2476	grid [label $frame3.lom3 -text U -bg beige] -column 7 -row 1 -padx 2 -pady 3 -sticky w
2477	grid $frame3.om3 -column 8 -row 1 -padx 2 -pady 3 -sticky w
2478	grid [label $frame3.lom4 -text F -bg beige] -column 9 -row 1 -padx 2 -pady 3 -sticky w
2479	grid $frame3.om4 -column 10 -row 1 -padx 2 -pady 3 -sticky w
2480
2481	set expgui(atomreflbl) "$frame3.l1 $frame3.l4 $frame3.lom2 $frame3.lom3 $frame3.lom4 "
2482	set expgui(atomref) "$frame3.cf1 $frame3.cf2 $frame3.cf3 $frame3.om2 $frame3.om3 $frame3.om4"
2483
2484	set coords [frame $frame3.coords -width 100 -borderwidth 0 -bg beige]
2485	grid $coords -column 0 -row 6 -columnspan 12 -sticky nsew
2486
2487	set f3l1 [label $frame3.coords.l1 -text "Label" -bg beige]
2488	set f3e1 [entry $frame3.coords.e1 -textvariable entryvar(label) -width 6]
2489	set f3l8 [label $frame3.coords.l8 -text "Coordinates" -bg beige]
2490	set f3e8 [entry $frame3.coords.e8 -textvariable entryvar(x) -width 10]
2491	set f3e9 [entry $frame3.coords.e9 -textvariable entryvar(y) -width 10]
2492	set f3e10 [entry $frame3.coords.e10 -textvariable entryvar(z) -width 10]
2493	set f3l11 [label $frame3.coords.l11 -text "Occupancy" -bg beige]
2494	set f3e11 [entry $frame3.coords.e11 -textvariable entryvar(frac) -width 10]
2495	set expgui(atomlabels) "$frame3.coords.l1 $frame3.coords.l8 $frame3.coords.l11"
2496	set expgui(atomentry) "$frame3.coords.e1 $frame3.coords.e8 $frame3.coords.e9 $frame3.coords.e10 $frame3.coords.e11"
2497
2498	grid $f3l1 -column 0 -row 4 -padx 2 -sticky nsw -pady 3
2499	grid $f3e1 -column 1 -row 4 -padx 2 -sticky nsw -pady 3
2500	grid $f3l8 -column 2 -row 4 -padx 2 -sticky nsw -pady 3
2501	grid $f3e8 -column 3 -row 4 -padx 2 -sticky nsw -pady 3
2502	grid $f3e9 -column 4 -row 4 -padx 2 -sticky nsw -pady 3
2503	grid $f3e10 -column 5 -row 4 -padx 2 -sticky nsw -pady 3
2504	grid $f3l11 -column 6 -row 4 -padx 2 -sticky nsw -pady 3
2505	grid $f3e11 -column 7 -row 4 -padx 2 -sticky nsw -pady 3
2506
2507
2508	set f3f31 [frame $frame3.f3f31 -width 100 -borderwidth 0 -bg beige]
2509	grid $f3f31 -column 0 -row 7 -columnspan 12
2510	set expgui(anisolabels) {}
2511	lappend expgui(anisolabels) [label $f3f31.l13 -text "Uiso" -bg beige]
2512	lappend expgui(anisolabels) [label $f3f31.l14 -text "U22" -bg beige]
2513	lappend expgui(anisolabels) [label $f3f31.l15 -text "U33" -bg beige]
2514	lappend expgui(anisolabels) [label $f3f31.l16 -text "U12" -bg beige]
2515	lappend expgui(anisolabels) [label $f3f31.l17 -text "U13" -bg beige]
2516	lappend expgui(anisolabels) [label $f3f31.l18 -text "U23" -bg beige]
2517
2518	set expgui(anisoentry) {}
2519	lappend expgui(anisoentry) [entry $f3f31.e13 -textvariable entryvar(U11) -width 10]
2520	lappend expgui(anisoentry) [entry $f3f31.e14 -textvariable entryvar(U22) -width 10]
2521	lappend expgui(anisoentry) [entry $f3f31.e15 -textvariable entryvar(U33) -width 10]
2522	lappend expgui(anisoentry) [entry $f3f31.e16 -textvariable entryvar(U12) -width 10]
2523	lappend expgui(anisoentry) [entry $f3f31.e17 -textvariable entryvar(U13) -width 10]
2524	lappend expgui(anisoentry) [entry $f3f31.e18 -textvariable entryvar(U23) -width 10]
2525
2526	set col 0
2527	foreach item1 $expgui(anisolabels) item2 $expgui(anisoentry) {
2528	grid $item1 -column $col -row 0 -sticky nsw -pady 3
2529	incr col
2530	grid $item2 -column $col -row 0 -sticky nsw -pady 3
2531	incr col
2532	}
2533	# --------------------------- End Edit Box --------------------------------
2534
2535	#/\ /\ /\ /\ /\ /\ /\ END OF PHASE PANE CODE /\ /\ /\ /\ /\ /\ /\ /\ /\ /\ /\
2536	#-----------------------------------------------------------------------------
2537	#v v v v v v v v v v BEGINNING OF HISTOGRAM PANE CODE v v v v v v v v v v v v
2538	grid [frame $expgui(histFrame).hs] \
2539	-column 0 -row 0 -rowspan 10 -sticky nsew
2540	grid columnconfigure $expgui(histFrame) 0 -weight 1
2541	grid rowconfigure $expgui(histFrame) 1 -weight 1
2542	grid rowconfigure $expgui(histFrame) 2 -weight 1
2543	grid rowconfigure $expgui(histFrame) 3 -weight 1
2544	grid [listbox $expgui(histFrame).hs.title -height 1 -relief flat \
2545	-font $expgui(histfont) ] -row 0 -column 0 -sticky ew
2546	grid [listbox $expgui(histFrame).hs.lbox -height 10 -width 25 \
2547	-font $expgui(histfont) \
2548	-xscrollcommand "$expgui(histFrame).hs.x set" \
2549	-yscrollcommand "$expgui(histFrame).hs.y set" \
2550	] -row 1 -column 0 -sticky news
2551	lappend expgui(HistSelectList) $expgui(histFrame).hs
2552	grid [scrollbar $expgui(histFrame).hs.x -orient horizontal \
2553	-command "move2boxes \" $expgui(histFrame).hs.title $expgui(histFrame).hs.lbox \" "
2554	] -row 2 -column 0 -sticky ew
2555	grid [scrollbar $expgui(histFrame).hs.y \
2556	-command "$expgui(histFrame).hs.lbox yview"] \
2557	-row 1 -column 1 -sticky ns
2558	grid columnconfigure $expgui(histFrame).hs 0 -weight 1
2559	grid rowconfigure $expgui(histFrame).hs 1 -weight 1
2560	bind $expgui(histFrame).hs.lbox <ButtonRelease-1> {
2561	set expgui(curhist) [$expgui(histFrame).hs.lbox curselection]
2562	DisplayHistogram
2563	}
2564	bind $expgui(histFrame).hs.lbox <Button-3> {
2565	if $expgui(globalmode) {
2566	$expgui(histFrame).hs.lbox selection set 0 end
2567	set expgui(curhist) [$expgui(histFrame).hs.lbox curselection]
2568	DisplayHistogram
2569	}
2570	}
2571
2572
2573	frame $expgui(histFrame).top -borderwidth 4 -relief groove
2574	grid [label $expgui(histFrame).top.txt] -row 0 -column 0
2575	if $expgui(havetix) {
2576	foreach item {backBox diffBox} num {2 3} \
2577	title {Background "Diffractometer Constants"} {
2578	tixLabelFrame $expgui(histFrame).$item \
2579	-borderwidth 4 -width 600 -height 100 -label $title
2580	grid $expgui(histFrame).$item -column 1 -row $num -sticky nsew
2581	set expgui($item) [$expgui(histFrame).$item subwidget frame]
2582	}
2583	} else {
2584	foreach item {backBox diffBox} num {1 2} \
2585	title {Background "Diffractometer Constants"} {
2586	frame $expgui(histFrame).$item -borderwidth 4 -relief groove
2587	grid $expgui(histFrame).$item -column 1 -row $num -sticky nsew
2588	set expgui($item) $expgui(histFrame).$item
2589	grid [label $expgui(histFrame).$item.title -text $title] \
2590	-row 0 -column 0 -columnspan 10 -sticky nw
2591	}
2592	}
2593
2594	# BACKGROUND information.
2595	# <<<<<<<<<<<<<<<<<<<<<<<<< BACKGROUND <<<<<<<<<<<<<<<<<<<<<
2596	grid [ frame $expgui(backBox).f ] -row 0 -column 0 -columnspan 11
2597	grid [ label $expgui(backBox).f.lBGType -textvariable expgui(backtypelbl)] \
2598	-row 1 -column 0 -sticky nws -padx 2 -pady 3
2599	grid [ label $expgui(backBox).f.lBGTerms -textvariable expgui(backtermlbl)] \
2600	-row 1 -column 1 -sticky nws -padx 2 -pady 3
2601	grid [ button $expgui(backBox).f.edit -textvariable expgui(bkglbl) \
2602	-command editbackground] \
2603	-row 1 -column 2 -columnspan 3 -sticky w -padx 2 -pady 3
2604	grid [ frame $expgui(backBox).f1 ] -row 1 -column 0 -columnspan 11 -sticky e
2605	grid [ label $expgui(backBox).f1.lfBG -text " Refine background" ] \
2606	-row 2 -column 1 -sticky news -padx 4 -pady 3
2607	grid [ checkbutton $expgui(backBox).f1.rfBG -text "" \
2608	-variable entryvar(bref) ] \
2609	-row 2 -column 2 -sticky news -padx 4 -pady 3
2610	grid [ label $expgui(backBox).f1.lBGDamp -text Damping ] \
2611	-row 2 -column 3 -sticky w -padx 2 -pady 3
2612	tk_optionMenu $expgui(backBox).f1.om entryvar(bdamp) 0 1 2 3 4 5 6 7 8 9
2613	grid $expgui(backBox).f1.om \
2614	-row 2 -column 4 -sticky news -padx 4 -pady 3 -sticky e
2615
2616	# DIFFRACTOMETER CONSTANTS SECTION
2617
2618	#^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^END OF HISTOGRAM PANE CODE ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^
2619	###############################################################################
2620	#v v v v v v v v v v BEGINNING OF SCALING PANE CODE v v v v v v v v v v
2621
2622	pack [frame $expgui(fracFrame).hs] -side left -expand y -fill both
2623	grid [listbox $expgui(fracFrame).hs.title -height 1 -relief flat \
2624	-font $expgui(histfont) ] -row 0 -column 0 -sticky ew
2625	grid [listbox $expgui(fracFrame).hs.lbox -height 10 -width 25 \
2626	-font $expgui(histfont) \
2627	-xscrollcommand "$expgui(fracFrame).hs.x set" \
2628	-yscrollcommand "$expgui(fracFrame).hs.y set" \
2629	] -row 1 -column 0 -sticky news
2630	lappend expgui(HistSelectList) $expgui(fracFrame).hs
2631	grid [scrollbar $expgui(fracFrame).hs.x -orient horizontal \
2632	-command "move2boxes \" $expgui(fracFrame).hs.title $expgui(fracFrame).hs.lbox \" "
2633	] -row 2 -column 0 -sticky ew
2634	grid [scrollbar $expgui(fracFrame).hs.y \
2635	-command "$expgui(fracFrame).hs.lbox yview"] \
2636	-row 1 -column 1 -sticky ns
2637	grid columnconfigure $expgui(fracFrame).hs 0 -weight 1
2638	grid rowconfigure $expgui(fracFrame).hs 1 -weight 1
2639	bind $expgui(fracFrame).hs.lbox <ButtonRelease-1> {
2640	set expgui(curhist) [$expgui(fracFrame).hs.lbox curselection]
2641	DisplayFrac
2642	}
2643	bind $expgui(fracFrame).hs.lbox <Button-3> {
2644	if $expgui(globalmode) {
2645	$expgui(fracFrame).hs.lbox selection set 0 end
2646	set expgui(curhist) [$expgui(fracFrame).hs.lbox curselection]
2647	DisplayFrac
2648	}
2649	}
2650	pack [frame $expgui(fracFrame).f1] -fill both -expand true
2651	# Create a large canvas area containing a frame for each phase in the data set.
2652	# The canvas and vertical scrollbar are inside a frame called f1
2653	if $expgui(havetix) {
2654	tixLabelFrame $expgui(fracFrame).f1.scaleBox \
2655	-borderwidth 4 -width 600 -height 100 -label "Scale Factor"
2656	grid $expgui(fracFrame).f1.scaleBox -column 0 -row 0 -sticky nsew -columnspan 2
2657	set expgui(scaleBox) [$expgui(fracFrame).f1.scaleBox subwidget frame]
2658	} else {
2659	frame $expgui(fracFrame).f1.scaleBox -borderwidth 4 -relief groove
2660	grid $expgui(fracFrame).f1.scaleBox -column 0 -row 0 -sticky nsew -columnspan 2
2661	set expgui(scaleBox) $expgui(fracFrame).f1.scaleBox
2662	}
2663	grid [label $expgui(scaleBox).histSFLabel -text "Scale Factor"] \
2664	-row 1 -column 0 -sticky nws -padx 2 -pady 3
2665	grid [entry $expgui(scaleBox).ent1 -textvariable entryvar(scale) -width 15] \
2666	-row 1 -column 1 -sticky ew -padx 4 -pady 3
2667	button $expgui(scaleBox).but1 -text "Set Globally" \
2668	-command "editglobalparm histinfo scale {Scale Factor}"
2669
2670	grid [label $expgui(scaleBox).histSFRLabel -text " Refine"] \
2671	-row 1 -column 2 -sticky nws -padx 2 -pady 3
2672	grid [checkbutton $expgui(scaleBox).rf -variable entryvar(sref)] \
2673	-row 1 -column 3 -sticky news -padx 4 -pady 3
2674	grid [label $expgui(scaleBox).lD1 -text "Damping"] \
2675	-row 1 -column 4 -sticky w -padx 2 -pady 3
2676	tk_optionMenu $expgui(scaleBox).om entryvar(sdamp) 0 1 2 3 4 5 6 7 8 9
2677	grid $expgui(scaleBox).om \
2678	-row 1 -column 5 -sticky news -padx 4 -pady 3
2679	grid columnconfigure $expgui(scaleBox) 6 -weight 1
2680
2681	grid [set expgui(FracBox) [canvas $expgui(fracFrame).f1.fracBox \
2682	-scrollregion {0 0 5000 500} -width 500 -height 350 -bg lightgrey]] \
2683	-sticky news -row 1 -column 0
2684	grid [scrollbar $expgui(fracFrame).f1.yscroll -orient vertical] \
2685	-sticky ns -row 1 -column 1
2686
2687	$expgui(FracBox) config -yscrollcommand "$expgui(fracFrame).f1.yscroll set"
2688	$expgui(fracFrame).f1.yscroll config -command { $expgui(FracBox) yview }
2689
2690	grid columnconfigure $expgui(fracFrame).f1 0 -weight 1
2691	grid rowconfigure $expgui(fracFrame).f1 0 -weight 1
2692	frame $expgui(FracBox).f -bd 0
2693	$expgui(FracBox) create window 0 0 -anchor nw -window $expgui(FracBox).f
2694
2695	# the rest of the page is created in DisplayFrac
2696	# ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ END OF SCALING PANE CODE ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^
2697	###############################################################################
2698	# v v v v v v v v v v BEGINNING OF PROFILE PANE CODE v v v v v v v v v v v v v
2699	pack [frame $expgui(profFrame).hs] -side left -expand y -fill both
2700	grid [listbox $expgui(profFrame).hs.title -height 1 -relief flat \
2701	-font $expgui(histfont) ] -row 0 -column 0 -sticky ew
2702	grid [listbox $expgui(profFrame).hs.lbox -height 10 -width 25 \
2703	-font $expgui(histfont) \
2704	-xscrollcommand "$expgui(profFrame).hs.x set" \
2705	-yscrollcommand "$expgui(profFrame).hs.y set" \
2706	] -row 1 -column 0 -sticky news
2707	lappend expgui(HistSelectList) $expgui(profFrame).hs
2708	grid [scrollbar $expgui(profFrame).hs.x -orient horizontal \
2709	-command "move2boxes \" $expgui(profFrame).hs.title $expgui(profFrame).hs.lbox \" "
2710	] -row 2 -column 0 -sticky ew
2711	grid [scrollbar $expgui(profFrame).hs.y \
2712	-command "$expgui(profFrame).hs.lbox yview"] \
2713	-row 1 -column 1 -sticky ns
2714	grid columnconfigure $expgui(profFrame).hs 0 -weight 1
2715	grid rowconfigure $expgui(profFrame).hs 1 -weight 1
2716	bind $expgui(profFrame).hs.lbox <ButtonRelease-1> {
2717	set expgui(curhist) [$expgui(profFrame).hs.lbox curselection]
2718	DisplayProfile
2719	}
2720	bind $expgui(profFrame).hs.lbox <Button-3> {
2721	if $expgui(globalmode) {
2722	$expgui(profFrame).hs.lbox selection set 0 end
2723	set expgui(curhist) [$expgui(profFrame).hs.lbox curselection]
2724	DisplayProfile
2725	}
2726	}
2727
2728	# Create a large canvas area containing a frame for each phase in the data set.
2729	# The canvas and vertical scrollbar are inside a frame called f1
2730	pack [frame $expgui(profFrame).f1] -fill both -expand true
2731	grid [set expgui(ProfileBox) [canvas $expgui(profFrame).f1.profileBox \
2732	-scrollregion {0 0 5000 500} -width 500 -height 350 -bg lightgrey]] \
2733	-sticky news -row 0 -column 0
2734	grid [scrollbar $expgui(profFrame).f1.yscroll -orient vertical] \
2735	-sticky ns -row 0 -column 1
2736
2737	$expgui(ProfileBox) config -yscrollcommand "$expgui(profFrame).f1.yscroll set"
2738	$expgui(profFrame).f1.yscroll config -command { $expgui(ProfileBox) yview }
2739
2740	grid columnconfigure $expgui(profFrame).f1 1 -weight 1
2741	grid rowconfigure $expgui(profFrame).f1 0 -weight 1
2742	frame $expgui(ProfileBox).f -bd 0
2743	$expgui(ProfileBox) create window 0 0 -anchor nw -window $expgui(ProfileBox).f
2744
2745	# ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ END OF PROFILE PANE CODE ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^
2746	##############################################################################
2747	# v v v v v v v v v v BEGINNING OF LS PANE CODE v v v v v v v v v v v v v
2748	array set printopts {
2749	0 "Print the reciprocal metric tensor changes"
2750	1 "Print the correlation matrix"
2751	2 "Print the Least-Squares matrices and vectors"
2752	4 "Print the linear constraint matrices"
2753	5 "Print the applied shifts and shift factors"
2754	6 "Print the reciprocal metric tensor Var-Covar terms"
2755	7 "Print all parameters for each cycle"
2756	8 "Print summary shift/esd data after last cycle"
2757	9 "Print zero/unit pole figure constraint terms"
2758	}
2759	pack [frame $expgui(lsFrame).hs] -side left -expand y -fill both
2760	grid [listbox $expgui(lsFrame).hs.title -height 1 -relief flat \
2761	-font $expgui(histfont) ] -row 0 -column 0 -sticky ew
2762	grid [listbox $expgui(lsFrame).hs.lbox -height 10 -width 25 \
2763	-font $expgui(histfont) \
2764	-xscrollcommand "$expgui(lsFrame).hs.x set" \
2765	-yscrollcommand "$expgui(lsFrame).hs.y set" \
2766	] -row 1 -column 0 -sticky news
2767	lappend expgui(HistSelectList) $expgui(lsFrame).hs
2768	grid [scrollbar $expgui(lsFrame).hs.x -orient horizontal \
2769	-command "move2boxes \" $expgui(lsFrame).hs.title $expgui(lsFrame).hs.lbox \" "
2770	] -row 2 -column 0 -sticky ew
2771	grid [scrollbar $expgui(lsFrame).hs.y \
2772	-command "$expgui(lsFrame).hs.lbox yview"] \
2773	-row 1 -column 1 -sticky ns
2774	grid columnconfigure $expgui(lsFrame).hs 0 -weight 1
2775	grid rowconfigure $expgui(lsFrame).hs 1 -weight 1
2776	bind $expgui(lsFrame).hs.lbox <ButtonRelease-1> {
2777	set expgui(curhist) [$expgui(lsFrame).hs.lbox curselection]
2778	SetupExtractHist
2779	}
2780	bind $expgui(lsFrame).hs.lbox <Button-3> {
2781	if $expgui(globalmode) {
2782	$expgui(lsFrame).hs.lbox selection set 0 end
2783	set expgui(curhist) [$expgui(lsFrame).hs.lbox curselection]
2784	SetupExtractHist
2785	}
2786	}
2787
2788	pack [frame $expgui(lsFrame).f1] -fill both -expand true
2789	grid rowconfigure $expgui(lsFrame).f1 4 -weight 1
2790	set row 0
2791	grid [label $expgui(lsFrame).f1.his1 -pady 6 -text "Last History:"] -row $row -column 0
2792	grid [label $expgui(lsFrame).f1.his2 -relief sunken -bd 2 -pady 6 \
2793	-textvariable expgui(last_History)] \
2794	-row $row -column 1 -columnspan 5 -sticky w
2795	incr row
2796	grid [label $expgui(lsFrame).f1.tit1 -pady 6 -text "Title:"] -row $row -column 0
2797	grid [entry $expgui(lsFrame).f1.tit2 \
2798	-textvariable entryvar(title) -width 48] \
2799	-row $row -column 1 -columnspan 5 -sticky w
2800	set entrycmd(title) "expinfo title"
2801
2802	incr row
2803	grid [frame $expgui(lsFrame).f1.b -bd 4 -relief groove] \
2804	-row $row -column 0 -columnspan 2 -pady 3
2805	grid [label $expgui(lsFrame).f1.b.lcyc -text "Number of Cycles"] -row 0 -column 0
2806	grid [entry $expgui(lsFrame).f1.b.ecyc -width 3 \
2807	-textvariable entryvar(cycles)] -row 0 -column 1
2808	grid [menubutton $expgui(lsFrame).f1.lprint -textvariable expgui(printopt) \
2809	-menu $expgui(lsFrame).f1.lprint.menu -bd 4 -relief raised \
2810	] -row $row -column 2
2811	menu $expgui(lsFrame).f1.lprint.menu
2812	foreach num [lsort [array names printopts]] {
2813	$expgui(lsFrame).f1.lprint.menu add checkbutton \
2814	-label "$printopts($num) ([expr int(pow(2,$num))])"\
2815	-variable entryvar(printopt$num)
2816	}
2817	grid [frame $expgui(lsFrame).f1.c -bd 4 -relief groove] -row $row -column 3
2818	grid [label $expgui(lsFrame).f1.c.fol -text "Extract Fobs"] -row 0 -column 2
2819	grid [checkbutton $expgui(lsFrame).f1.c.foc -variable entryvar(fobsextract)] -row 0 -column 3
2820	incr row
2821	grid [frame $expgui(lsFrame).f1.a -bd 4 -relief groove] -row $row -column 0 -columnspan 6
2822	foreach num {1 2 3 4 5 6 7 8 9} {
2823	grid [label $expgui(lsFrame).f1.a.l$num -text $num] -row 1 -column $num
2824	grid [radiobutton $expgui(lsFrame).f1.a.cc$num \
2825	-command "HistExtractSet $num" \
2826	-variable expgui(Fextract$num) -value 0] \
2827	-row 2 -column $num
2828	grid [radiobutton $expgui(lsFrame).f1.a.ca$num \
2829	-command "HistExtractSet $num" \
2830	-variable expgui(Fextract$num) -value 1] \
2831	-row 3 -column $num
2832	# grid [radiobutton $expgui(lsFrame).f1.a.cb$num \
2833	# -command "HistExtractSet $num" \
2834	# -variable expgui(Fextract$num) -value 2] \
2835	# -row 4 -column $num
2836	}
2837	set expgui(ExtractSettingsRadiobuttons) $expgui(lsFrame).f1.a.cc
2838	lappend expgui(ExtractSettingsRadiobuttons) $expgui(lsFrame).f1.a.ca
2839	#lappend expgui(ExtractSettingsRadiobuttons) $expgui(lsFrame).f1.a.cb
2840
2841	grid [label $expgui(lsFrame).f1.a.t -text "Intensity Extraction Method" -anchor c] \
2842	-column 0 -columnspan 11 -row 0
2843	grid [label $expgui(lsFrame).f1.a.t0 -text "Phase #" -anchor c] -column 0 -row 1
2844	grid [label $expgui(lsFrame).f1.a.t1 -text "Rietveld" -anchor c] -column 0 -row 2
2845	grid [label $expgui(lsFrame).f1.a.t2 -text "F(calc) Weighted" -anchor c] -column 0 -row 3
2846	#grid [label $expgui(lsFrame).f1.a.t3 -text "Equally Weighted" -anchor c] -column 0 -row 4
2847	grid [label $expgui(lsFrame).f1.a.t2a -text "(Model biased)" -anchor c] -column 10 -row 3
2848	#grid [label $expgui(lsFrame).f1.a.t3a -text "(Le Bail method)" -anchor c] -column 10 -row 4
2849	# ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ END OF LS PANE CODE ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^
2850	#-------------------------------------------------------------------------
2851	#-------------------------------------------------------------------------
2852	#vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv THE MENU BAR vvvvvvvvvvvvvvvvvvvvvv
2853
2854	#---- file menu button
2855	menubutton $expgui(fm).file -text File -underline 0 -menu $expgui(fm).file.menu
2856	menu $expgui(fm).file.menu
2857	if $expgui(debug) {
2858	$expgui(fm).file.menu add command -label "Reset" -underline 0 \
2859	-command "reset"
2860	}
2861	$expgui(fm).file.menu add command -label "expnam" -underline 0 \
2862	-command readnewexp
2863	$expgui(fm).file.menu add command -label "Save" -underline 0 \
2864	-command savearchiveexp
2865	$expgui(fm).file.menu add command -label "Save As" -underline 1 \
2866	-command "SaveAsFile"
2867	$expgui(fm).file.menu add command -label "Reread .EXP file" -underline 0 \
2868	-command {rereadexp $expgui(expfile)}
2869	#$expgui(fm).file.menu add command -label "Close" -underline 0
2870
2871	#---- help menu button
2872	menubutton $expgui(fm).help -text Help -underline 0 -menu $expgui(fm).help.menu
2873	menu $expgui(fm).help.menu
2874	$expgui(fm).help.menu add command -command showhelp -label "Help on Command"
2875	$expgui(fm).help.menu add command -label "About..." -underline 0 -command About
2876
2877	#---- options menu button
2878	menubutton $expgui(fm).option -text Options -underline 0 \
2879	-menu $expgui(fm).option.menu
2880	menu $expgui(fm).option.menu
2881
2882	$expgui(fm).option.menu add checkbutton -label "Archive EXP" \
2883	-variable expgui(archive) -underline 0
2884
2885	$expgui(fm).option.menu add cascade -menu $expgui(fm).option.menu.asort \
2886	-label "Sort atoms by"
2887
2888	set expgui(asorttype) number
2889	menu $expgui(fm).option.menu.asort
2890	$expgui(fm).option.menu.asort add radiobutton -command DisplayAllAtoms \
2891	-label number -value number -variable expgui(asorttype)
2892	$expgui(fm).option.menu.asort add radiobutton -command DisplayAllAtoms \
2893	-label type -value type -variable expgui(asorttype)
2894	$expgui(fm).option.menu.asort add radiobutton -command DisplayAllAtoms \
2895	-label x -value x -variable expgui(asorttype)
2896	$expgui(fm).option.menu.asort add radiobutton -command DisplayAllAtoms \
2897	-label y -value y -variable expgui(asorttype)
2898	$expgui(fm).option.menu.asort add radiobutton -command DisplayAllAtoms \
2899	-label z -value z -variable expgui(asorttype)
2900
2901
2902	$expgui(fm).option.menu add cascade -menu $expgui(fm).option.menu.hsort \
2903	-label "Sort histograms by"
2904
2905	set expgui(hsorttype) number
2906	menu $expgui(fm).option.menu.hsort
2907	$expgui(fm).option.menu.hsort add radiobutton -command sethistlist \
2908	-label number -value number -variable expgui(hsorttype)
2909	$expgui(fm).option.menu.hsort add radiobutton -command sethistlist \
2910	-label "Histogram type" -value type -variable expgui(hsorttype)
2911	$expgui(fm).option.menu.hsort add radiobutton -command sethistlist \
2912	-label "Bank #" -value bank -variable expgui(hsorttype)
2913	$expgui(fm).option.menu.hsort add radiobutton -command sethistlist \
2914	-label "Angle/Wavelength" -value angle -variable expgui(hsorttype)
2915
2916	#---- Global mode menu button
2917	$expgui(fm).option.menu add cascade -menu $expgui(fm).option.menu.editmode \
2918	-label "Multiple hist. selection"
2919	menu $expgui(fm).option.menu.editmode
2920	$expgui(fm).option.menu.editmode add radiobutton -label "Off" \
2921	-variable expgui(globalmode) -underline 0 -value 0\
2922	-command sethistlist
2923	$expgui(fm).option.menu.editmode add radiobutton -label "All" \
2924	-variable expgui(globalmode) -underline 0 -value 6 \
2925	-command sethistlist
2926	$expgui(fm).option.menu.editmode add radiobutton -label "TOF" \
2927	-variable expgui(globalmode) -underline 0 -value 1 \
2928	-command sethistlist
2929	$expgui(fm).option.menu.editmode add radiobutton -label "CW Neutron" \
2930	-variable expgui(globalmode) -underline 0 -value 2 \
2931	-command sethistlist
2932	$expgui(fm).option.menu.editmode add radiobutton -label "Alpha12 Xray" \
2933	-variable expgui(globalmode) -underline 0 -value 3 \
2934	-command sethistlist
2935	$expgui(fm).option.menu.editmode add radiobutton -label "Monochromatic Xray" \
2936	-variable expgui(globalmode) -underline 0 -value 4 \
2937	-command sethistlist
2938	$expgui(fm).option.menu.editmode add radiobutton -label "Energy Disp Xray" \
2939	-variable expgui(globalmode) -underline 0 -value 5 \
2940	-command sethistlist
2941	set expgui(globalmode) 0
2942
2943	if {$tcl_platform(platform) != "windows"} {
2944	$expgui(fm).option.menu add checkbutton -label "Override backspace" \
2945	-variable env(GSASBACKSPACE)
2946	}
2947	$expgui(fm).option.menu add command -label "Save Options" -underline 1 \
2948	-command "SaveOptions"
2949
2950	pack $expgui(fm).file $expgui(fm).option -side left -in $expgui(fm)
2951
2952	foreach menu $expgui(menunames) {
2953	set m [string tolower $menu]
2954	pack [menubutton $expgui(fm).$m -text $menu -underline 0 \
2955	-menu $expgui(fm).$m.menu] -side left
2956	menu $expgui(fm).$m.menu
2957	}
2958	pack $expgui(fm).help -side right -in $expgui(fm)
2959
2960	# add the commands in expgui_menulist
2961	foreach menu [array names expgui_menulist ] {
2962	foreach cmd $expgui_menulist($menu) {
2963	set action {}
2964	catch {set action [lindex $expgui_cmdlist($cmd) 0]}
2965	if {$expgui(debug) && $action == ""} {puts "blank command for $cmd"}
2966	if {$action != "" && $action != "-"} {
2967	eval $expgui(fm).$menu.menu add command \
2968	-label $cmd -command [list [subst $action]]
2969	}
2970	}
2971	}
2972	# setup command help
2973	foreach cmd [array names expgui_cmdlist] {
2974	set help {}
2975	catch {set help [lindex $expgui_cmdlist($cmd) 1]}
2976	if {$help == ""} {
2977	if {$expgui(debug)} {puts "no help for $cmd"}
2978	} else {
2979	# remove
2980	regsub -all \x09 $help " " help
2981	# preserve blank lines
2982	regsub -all \x0A\x0A $help "AAA1234567890AAA" help
2983	regsub -all \x0A $help " " help
2984	regsub -all "AAA1234567890AAA" $help \x0A\x0A help
2985	regsub -all " +" $help " " help
2986	set expgui_helplist($cmd) [string trim $help]
2987	}
2988	}
2989	# set up button bar
2990	foreach cmd $expgui(buttonlist) {
2991	set action {}
2992	catch {set action [lindex $expgui_cmdlist($cmd) 0]}
2993	if {$expgui(debug) && $action == ""} {puts "blank command for $cmd"}
2994	if {$action != ""} {
2995	pack [eval button .bar.$cmd -bg beige \
2996	-text $cmd -command [list [subst $action]]] -side left
2997	}
2998	}
2999
3000	$expgui(fm).file.menu add command -label "Exit" -underline 1 -command catchQuit
3001	#^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ END OF MENU DEFINITION ^^^^^^^^^^^^^^^^^^^
3002
3003
3004	# handle indirect exits
3005	wm protocol . WM_DELETE_WINDOW catchQuit
3006	bind . <Control-c> catchQuit
3007
3008	set expgui(curPhase) ""
3009	set expgui(pagenow) ""
3010	set expgui(curhist) {}
3011	set expgui(selectedatomlist) {}
3012
3013	loadexp $expgui(expfile)
3014
3015	# select the 1st phase
3016	SelectOnePhase [lindex $expmap(phaselist) 0]
3017	# select the first histogram in the list by default (if there are any)
3018	if {[llength $expmap(histlistboxcontents)] > 0} {
3019	set expgui(curhist) 0
3020	} else {
3021	set expgui(curhist) {}
3022	}
3023
3024	if !$expgui(havetix) {
3025	RaisePage lsFrame
3026	} else {
3027	.n raise lsPane
3028	set expgui(pagenow) lsFrame
3029	}

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

Download in other formats:

Original Format