Context Navigation

source: trunk/expgui @ 117

Last change on this file since 117 was 117, checked in by toby, 14 years ago
# on 1999/11/16 15:45:40, toby did: add timing option for debug try deleting trace for speed up (no improvement in speed under wish 8.1)
Property rcs:author set to `toby` Property rcs:date set to `1999/11/16 15:45:40` Property rcs:lines set to `+13 -3` Property rcs:rev set to `1.20` Property rcs:state set to `Exp` Property svn:keywords set to `Author Date Revision Id`
File size: 109.5 KB

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

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

Download in other formats:

Original Format