Context Navigation

source: trunk/expgui @ 20

Last change on this file since 20 was 20, checked in by toby, 13 years ago

# on 1999/01/06 04:15:12, toby did:
Many changes so that expgui incorporates tkgsas (gsas shell) capabilities

Allow expgui to create nearly empty .EXP files

Fix the various menus so that these blank files are treated properly

Property rcs:author set to toby
Property rcs:date set to 1999/01/06 04:15:12
Property rcs:lines set to +439 -266
Property rcs:rev set to 1.5
Property rcs:state set to Exp
Property svn:keywords set to Author Date Revision Id

File size: 105.9 KB

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

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

Download in other formats:

Original Format