Context Navigation

source: trunk/expgui @ 696

Last change on this file since 696 was 696, checked in by toby, 13 years ago
# on 2003/05/22 21:40:38, toby did: Implement windows init file as c:\GSAS\GSAS.CONFIG in place of .GSAS_CONFIG
Property rcs:author set to `toby` Property rcs:date set to `2003/05/22 21:40:38` Property rcs:lines set to `+10 -8` Property rcs:rev set to `1.61` Property rcs:state set to `Exp` Property svn:keywords set to `Author Date Revision Id`
File size: 147.4 KB

Line
1	#!/bin/sh
2	# the next line restarts this script using wish found in the path\
3	exec wish "$0" "$@"
4	# If this does not work, change the #!/usr/bin/wish line below
5	# to reflect the actual wish location and delete all preceeding lines
6	#
7	# (delete here and above)
8	#!/usr/bin/wish
9	# $Id: expgui 696 2009-12-04 23:10:29Z toby $
10	set expgui(Revision) {$Revision: 696 $ $Date: 2009-12-04 23:10:29 +0000 (Fri, 04 Dec 2009) $}
11
12	# to do:
13	#
14	# need to change heading and button label depending on where getExpFileName
15	# is called from?
16	#
17	# global background editing & profile work differently: should both
18	# start out blank with a "load from option"?
19	#
20	# idea:
21	# a scroll list for all histogram refinement flags ; click on takes you to the
22	# appropriate menu.
23	#
24	# idea:
25	# change cell parameters to labels and have a edit cell button
26	# that enforces metric symmetry
27	#
28	# to allow "global" access on phase page
29	# change buttons from radio to multiple
30	# -- or display all 9 cell flag/damps and all atoms
31	# make editMultipleRecords work with multiple phases, also cell flag/damp
32	# blank cell entries
33	# add phase to atom number in listing
34	# DisplayAllAtoms needs to loop over phases
35	#
36	# idea: load more than one bank from a multi-bank .RAW file
37	#
38	if {$tcl_version < 8.0} {
39	tk_dialog .expFileErrorMsg "Version Error" \
40	"EXPGUI requires Tcl/Tk version 8.0 or higher" error 0 "Exit"
41	exit
42	}
43
44	# the shell variable tells expgui to act as a shell for GSAS
45	# as well as edit the EXP file. In no-shell mode, it can
46	# only be used to edit the .EXP file as a callable program
47	set expgui(shell) 1
48	catch {if $env(EXPGUI_NOSHELL) {set expgui(shell) 0}}
49
50	if {$argv != ""} {
51	if {[string match noshell [string tolower $argv]]} {
52	#puts noshell
53	set expgui(shell) 0
54	set expgui(expfile) [lindex $argv 1]
55	} else {
56	set expgui(expfile) [lindex $argv 0]
57	}
58	if {[string toupper [file extension $expgui(expfile)]] != ".EXP"} {
59	append expgui(expfile) ".EXP"
60	}
61	} else {
62	set expgui(expfile) {}
63	}
64
65	set expgui(curhist) {}
66	set expmap(powderlist) {}
67	set expgui(bkgcolor1) #fdf
68
69	set expgui(debug) 0
70	catch {if $env(DEBUG) {set expgui(debug) 1}}
71	#set expgui(debug) 1
72
73	# location for web pages, if not found locally
74	set expgui(website) www.ncnr.nist.gov/xtal/software/expgui
75	# default for archive mode = on
76	set expgui(archive) 1
77	# default for autoexec load = off
78	set expgui(autoexpload) 0
79	# default for autostart GRWND = off
80	set expgui(autoGRWND) 0
81	# by default expgui is iconified while GENLES, etc runs
82	set expgui(autoiconify) 1
83	# default for show EXPTOOL output = off
84	set expgui(showexptool) 0
85	# save the name of the wish executable
86	set wishshell [info nameofexecutable]
87	# misc constants
88	set txtvw(font) "Courier"
89	set expgui(font) 14
90	set liveplot(hst) 1
91	set liveplot(legend) 1
92	set expgui(filesort) 1
93	set expgui(initstring) {}
94	# use a separate window for DISAGL (default)
95	set expgui(disaglSeparateBox) 1
96	set expgui(DefaultPeakType) 0
97	# default: keep current atoms when replacing a phase
98	set expgui(DeleteAllAtoms) 0
99	# flags for running POWPREF
100	set expgui(needpowpref) 0
101	set expgui(needpowpref_why) ""
102	#=============================================================================
103	#----------------------------------------------------------------
104	# where are we?
105	set expgui(script) [info script]
106	# translate links -- go six levels deep
107	foreach i {1 2 3 4 5 6} {
108	if {[file type $expgui(script)] == "link"} {
109	set link [file readlink $expgui(script)]
110	if { [file pathtype $link] == "absolute" } {
111	set expgui(script) $link
112	} {
113	set expgui(script) [file dirname $expgui(script)]/$link
114	}
115	} else {
116	break
117	}
118	}
119	# fixup relative paths
120	if {[file pathtype $expgui(script)] == "relative"} {
121	set expgui(script) [file join [pwd] $expgui(script)]
122	}
123	set expgui(scriptdir) [file dirname $expgui(script) ]
124	set expgui(gsasdir) [file dirname $expgui(scriptdir)]
125	set expgui(gsasexe) [file join $expgui(gsasdir) exe]
126	set expgui(docdir) [file join $expgui(scriptdir) doc]
127	#----------------------------------------------------------------
128	lappend auto_path $expgui(scriptdir)
129	set expgui(havetix) 0
130	set expgui(haveBW) 1
131	# for debugging non-BWidget version set environment variable NOBWIDGET
132	catch {if $env(NOBWIDGET) {set expgui(haveBW) 0}}
133	if $expgui(haveBW) {
134	if [catch {package require BWidget}] {set expgui(haveBW) 0}
135	}
136	# get the notebook widget if not using BWidgets
137	if {!$expgui(haveBW)} {source [file join $expgui(scriptdir) notebook.tcl]}
138	#----------------------------------------------------------------
139	source [file join $expgui(scriptdir) opts.tcl]
140	# fetch EXP file processing routines
141	source [file join $expgui(scriptdir) readexp.tcl]
142	# commands for running GSAS programs
143	source [file join $expgui(scriptdir) gsascmds.tcl]
144	# contents of GSAS menus
145	source [file join $expgui(scriptdir) gsasmenu.tcl]
146	# commands for adding phases, histograms & atoms
147	source [file join $expgui(scriptdir) addcmds.tcl]
148	# commands for preferred orientation
149	source [file join $expgui(scriptdir) orient.tcl]
150	# setting data range/excluded regions
151	source [file join $expgui(scriptdir) exclinit.tcl]
152	#---------------------------------------------------------------------------
153	# override options with locally defined values
154	set filelist [file join $expgui(scriptdir) localconfig]
155	if {$tcl_platform(platform) == "windows"} {
156	lappend filelist "c:/gsas.config"
157	} else {
158	lappend filelist [file join ~ .gsas_config]
159	}
160	if {[catch {
161	foreach file $filelist {
162	if [file exists $file] {source $file}
163	}
164	} errmsg]} {
165	set msg "Error reading file $file (aka [file nativename $file]): $errmsg"
166	MyMessageBox -parent . -title "Customize warning" \
167	-message $msg -icon warning -type Ignore -default ignore \
168	-helplink "expguierr.html Customizewarning"
169	}
170	SetTkDefaultOptions $expgui(font)
171	#---------------------------------------------------------------------------
172	# platform-specific code
173	if {$tcl_platform(platform) == "windows" \
174	&& $tcl_platform(os) == "Windows 95"} {
175	if [catch {package require winexec}] {
176	MyMessageBox -parent . -title "WINEXEC Error" \
177	-message "Error -- Unable to load the WINEXEC package. This is needed in Win95 machines" \
178	-icon error -type Quit -default quit \
179	-helplink "expgui_Win_readme.html Winexec"
180	destroy .
181	}
182	}
183	if {$tcl_platform(platform) == "windows"} {
184	# check the path -- can DOS use it?
185	if {[string first {\\} $expgui(script) ] != -1} {
186	MyMessageBox -parent . -title "Networked Path" \
187	-message "Note -- You may have problems running EXPGUI/GSAS from a network drive. If you have errors, map $expgui(gsasdir) to a \"drive\" (like F:). (Use \"Map network drive\" to do this.)" \
188	-icon error -type {"Be brave"} -default "be brave" \
189	-helplink "expgui_Win_readme.html NetPath"
190	}
191	#
192	set expgui(exptool) [file join $expgui(gsasexe) exptool.exe]
193	} else {
194	set expgui(exptool) [file join $expgui(gsasexe) exptool]
195	if [catch {set env(GSASBACKSPACE)}] {set env(GSASBACKSPACE) 1}
196	}
197	# do we have a PGPLOT fonts file?
198	# if it is in the "wrong" place/name -- make it "right"
199	if {![file exists [file join $expgui(gsasdir) pgl grfont.dat]] && \
200	[file exists [file join $expgui(gsasdir) fonts grfont.dat]]} {
201	catch {file mkdir [file join $expgui(gsasdir) pgl]}
202	file copy [file join $expgui(gsasdir) fonts grfont.dat] \
203	[file join $expgui(gsasdir) pgl grfont.dat]
204	}
205	# do we have a PGPLOT fonts file?
206	if {![file exists [file join $expgui(gsasdir) pgl grfont.dat]] && \
207	[file exists [file join $expgui(gsasdir) fonts pgfont.dat]]} {
208	catch {file mkdir [file join $expgui(gsasdir) pgl]}
209	file copy [file join $expgui(gsasdir) fonts pgfont.dat] \
210	[file join $expgui(gsasdir) pgl grfont.dat]
211	}
212	# do we have a PGPLOT fonts file?
213	if {![file exists [file join $expgui(gsasdir) pgl grfont.dat]] && \
214	[file exists [file join $expgui(gsasdir) pgl pgfont.dat]]} {
215	file copy [file join $expgui(gsasdir) pgl pgfont.dat] \
216	[file join $expgui(gsasdir) pgl grfont.dat]
217	}
218	if ![file exists [file join $expgui(gsasdir) pgl grfont.dat]] {
219	MyMessageBox -parent . -title "PGPLOT Error" \
220	-message "Warning -- Unable to find file GRFONT.DAT in [file join $expgui(gsasdir) pgl]. GSAS graphics will not work. Is GSAS correctly installed?" \
221	-icon warning -type {"Limp Ahead"} -default "Limp Ahead" \
222	-helplink "expguierr.html NoPGPLOT"
223	}
224	#---------------------------------------------------------------------------
225	if {$expgui(expfile) != ""} {
226	# is there a space in the EXP name?
227	if {[string first " " [file tail $expgui(expfile)]] != -1} {
228	update
229	MyMessageBox -parent . -title "File Name Error" \
230	-message "File name \"$expgui(expfile)\" is invalid -- EXPGUI cannot process experiment files with spaces in the name" \
231	-icon warning -type Continue -default continue
232	# -helplink "expguierr.html OpenErr"
233	set expgui(expfile) {}
234	} elseif {[string first " " [file dirname $expgui(expfile)]] != -1} {
235	update
236	MyMessageBox -parent . -title "Good luck..." \
237	-message "You are using a directory with a space in the name ([file dirname $expgui(expfile)]) -- You may encounter bugs in EXPGUI. Please e-mail them to Brian.Toby@NIST.gov so they can be fixed." \
238	-icon warning -type Continue -default continue
239	# -helplink "expguierr.html OpenErr"
240	} elseif ![file exists $expgui(expfile)] {
241	update
242	set ans [
243	MyMessageBox -parent . -title "File Open Error" \
244	-message "File [file tail $expgui(expfile)] does not exist in [file dirname $expgui(expfile)]. OK to create?" \
245	-icon question -type {"Select other" "Create"} -default "select other" \
246	-helplink "expguierr.html OpenErr"
247	]
248	if {[string tolower $ans] != "create"} {set expgui(expfile) {}}
249	}
250	}
251	if {$expgui(expfile) == ""} {
252	# center the parent window because the getExpFileName window
253	# will be centered above it.
254	wm withdraw .
255	set x [expr [winfo screenwidth .]/2 - [winfo reqwidth .]/2 ]
256	set y [expr [winfo screenheight .]/2 - [winfo reqheight .]/2]
257	wm geom . +$x+$y
258	wm deiconify .
259	# windows needed this update before when using tk_getOpenFile.
260	# I am not sure it is still needed.
261	update
262	#
263	set expgui(expfile) [getExpFileName old]
264	}
265	if {$expgui(expfile) == ""} exit
266	# you've been warned this .EXP does not exist!
267	if ![file exists $expgui(expfile)] {
268	# create an "empty" exp file
269	createexp $expgui(expfile) \
270	[getstring "title for experiment $expgui(expfile)" 60 0]
271	}
272	catch {cd [string trim [file dirname $expgui(expfile)]]}
273
274	#
275	# >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
276	# <<<<<<<<<< BEGINNING OF MAIN: GLOBAL AREA FOR DATA EXTRACTION >>>>>>>>>>>
277	# >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
278	# load exp file and set up dialogs
279	proc loadexp {expfile} {
280	global expgui expmap entryvar entrycmd tcl_platform
281	# is this a compressed archive file?
282	if {[string match {*.O[0-9A-F][0-9A-F]} $expfile]} {
283	set expgui(expfile) {}
284	set expnam [file rootname $expfile]
285	set ans [MyMessageBox -parent . -title "Load Archived File" \
286	-message "Loading archived version of $expnam. Do you want to continue using the same experiment name or work with the archived version under a new name?" \
287	-icon question -type "{Use New Name} {Continue with current}" \
288	-default {Use New Name} \
289	-helplink "expguierr.html LoadArchived"
290	]
291	# archive the current .EXP file
292	if {$ans != "use new name" && [file exists $expfile]} {
293	# get the last archived version
294	set lastf [lindex [lsort [glob -nocomplain $expnam.{O\[0-9A-F\]\[0-9A-F\]}]] end]
295	if {$lastf == ""} {
296	set num 01
297	} else {
298	regexp {.*\.O([0-9A-F][0-9A-F])$} $lastf a num
299	scan $num %x num
300	if {$num >= 255} {
301	set num FF
302	} else {
303	set num [string toupper [format %.2x [incr num]]]
304	}
305	}
306	catch {
307	set newfile $expnam.O$num
308	file rename -force $expnam.EXP $newfile
309	set fp [open $expnam.LST a+]
310	puts $fp "\n----------------------------------------------"
311	puts $fp " Regressing to archive file [file tail $expfile]"
312	puts $fp " but first archiving [file tail $expnam.EXP] as [file tail $newfile]"
313	puts $fp "----------------------------------------------\n"
314	close $fp
315	}
316	}
317	file copy -force $expfile $expnam.EXP
318	set fmt [expload $expfile]
319	# if the file was not in the correct format, force a rewrite before use
320	if {$fmt < 0} {
321	# read error
322	return
323	} elseif {$fmt == 1} {
324	set expgui(changed) 0
325	} else {
326	set expgui(changed) 1
327	}
328	set expfile $expnam.EXP
329	if {$ans == "use new name"} {
330	SaveAsFile
331	set expfile $expgui(expfile)
332	}
333	} else {
334	set exploadtime [time {set fmt [expload $expfile]}]
335	if $expgui(debug) {puts "expload $exploadtime"}
336	# if the file was not in the correct format, force a rewrite before use
337	if {$fmt < 0} {
338	# read error
339	return
340	} elseif {$fmt == 1} {
341	set expgui(changed) 0
342	} else {
343	set expgui(changed) 1
344	}
345	}
346	# force exp files to be upper case, force save if name changes
347	set filetail [file tail $expfile]
348	set filetailcaps [string toupper $filetail]
349	if {$tcl_platform(platform) == "unix" && $filetail != $filetailcaps} {
350	set expgui(changed) 1
351	}
352	if {[file dirname $expfile] == "."} {
353	set expgui(expfile) $filetailcaps
354	} else {
355	set expgui(expfile) [file join \
356	[file dirname $expfile] $filetailcaps]
357	}
358
359	mapexp
360	set expgui(expModifiedLast) 0
361	catch {
362	set expgui(expModifiedLast) [file mtime $expgui(expfile)]
363	}
364	set expgui(last_History) [string range [string trim [lindex [exphistory last] 1]] 0 50 ]
365	# set the window/icon title
366	wm title . "EXPGUI $expfile"
367	set expgui(titleunchanged) 1
368	wm iconname . [file tail $expfile]
369
370	# reset the phase buttons
371	set expgui(curPhase) ""
372	# set the number of phases on the phase page
373	setphases
374
375	# disable the "global options" that don't make sense based on
376	# which histograms present
377	foreach num {1 2 3 4 5} {
378	set flag($num) 0
379	}
380	# save a list of the allowed modes, too
381	set expgui(AllowedHistSelectModes) {0 6}
382	foreach h $expmap(powderlist) {
383	if {[string range $expmap(htype_$h) 2 2] == "T"} {set flag(1) 1}
384	if {[string range $expmap(htype_$h) 1 2] == "NC"} {set flag(2) 1}
385	if {[string range $expmap(htype_$h) 1 2] == "XC" && \
386	[histinfo $h lam2] != 0.0} {set flag(3) 1}
387	if {[string range $expmap(htype_$h) 1 2] == "XC" && \
388	[histinfo $h lam2] == 0.0} {set flag(4) 1}
389	if {[string range $expmap(htype_$h) 1 2] == "XE"} {set flag(5) 1}
390	}
391	foreach num {1 2 3 4 5} \
392	lbl {TOF "CW Neutron" "Alpha12 Xray" "Monochromatic Xray" \
393	"Energy Disp Xray"} {
394	if $flag($num) {
395	$expgui(fm).option.menu.editmode entryconfigure $lbl -state normal
396	lappend expgui(AllowedHistSelectModes) $num
397	} else {
398	$expgui(fm).option.menu.editmode entryconfigure $lbl -state disabled
399	}
400	}
401	# disable traces on entryvar until we are ready
402	set entrycmd(trace) 0
403	trace vdelete entryvar w entvartrace
404
405	# propogate changes on the least squares page
406	set entryvar(cycles) [expinfo cycles]
407	set entrycmd(cycles) "expinfo cycles"
408	# set expgui(globalmode) 0
409	set expgui(printopt) "Print Options ([expinfo print])"
410	set entryvar(title) [expinfo title]
411	global printopts
412	foreach num [array names printopts] {
413	set entrycmd(printopt$num) "printsetting $num"
414	set entryvar(printopt$num) [printsetting $num]
415	}
416	# enable traces on entryvar
417	set entrycmd(trace) 1
418	trace variable entryvar w entvartrace
419
420	# set fo extraction on LS page
421	SetupExtractHist
422	# set convergence criterion
423	InitLSvars
424
425	# update the histogram list & update the page
426	sethistlist
427
428	# start checking for external changes
429	afterawhile
430	}
431
432	# called to reread the .EXP file
433	proc rereadexp {expfile} {
434	global expgui
435	if $expgui(changed) {
436	set decision [tk_dialog .instrSaveData {Save .EXP changes} \
437	{You have made changes to the Experiment. Rereading will cause the changes to be lost. Select an option:} \
438	{} 0 "Save and reread" "Reread without Save" "Cancel reread command"]
439	switch $decision {
440	0 { savearchiveexp }
441	1 { }
442	2 { return }
443	}
444	}
445	loadexp $expgui(expfile)
446	}
447
448	proc SaveAsFile {} {
449	global expgui
450	set newexpfile [getExpFileName new]
451	if {$newexpfile == ""} return
452	expwrite $newexpfile
453	set expgui(expfile) $newexpfile
454	catch {cd [string trim [file dirname $expgui(expfile)]]}
455	set expgui(changed) 0
456	set expgui(expModifiedLast) [file mtime $expgui(expfile)]
457	set expgui(last_History) [string range [string trim [lindex [exphistory last] 1]] 0 50 ]
458	# set the window/icon title
459	wm title . $expgui(expfile)
460	set expgui(titleunchanged) 1
461	wm iconname . [file tail $expgui(expfile)]
462	# set convergence criterion
463	InitLSvars
464	}
465
466	# called to read a different .EXP file
467	proc readnewexp {} {
468	global expgui expmap
469	if $expgui(changed) {
470	set decision [tk_dialog .instrSaveData {Save .EXP changes} \
471	{You have made changes to the Experiment. Reading a different file without first saving will cause the changes to be lost. Select an option:} \
472	{} 0 "Save and read" "Read without Save" "Cancel read command"]
473	switch $decision {
474	0 { savearchiveexp }
475	1 { }
476	2 { return }
477	}
478	}
479	set newexpfile [getExpFileName old]
480	if {$newexpfile == ""} return
481
482	# switch to the 1st page
483	RaisePage lsFrame
484
485	if ![file exists $newexpfile] {
486	# you've been warned this .EXP does not exist!
487	# create an "empty" exp file
488	createexp $newexpfile \
489	[getstring "title for experiment $newexpfile" 60 0]
490	}
491	set expgui(expfile) $newexpfile
492	catch {cd [string trim [file dirname $expgui(expfile)]]}
493	set expgui(globalmode) 0
494	loadexp $expgui(expfile)
495
496	# reset the phase selection
497	set expgui(curPhase) {}
498
499	# select the first histogram in the list by default (if there are any)
500	if {[llength $expmap(histlistboxcontents)] > 0} {
501	set expgui(curhist) 0
502	} else {
503	set expgui(curhist) {}
504	}
505	if {[CountHistory] > 100} {
506	DeleteHistoryRecords "This .EXP file has [CountHistory] history records\nErasing most will speed EXPGUI"
507	}
508	}
509
510	#------------- set up data read/write layer ----------------------
511	# trace routine on entryvar
512	proc entvartrace {array elem action} {
513	global expgui entrycmd entryvar entrybox
514	if !$entrycmd(trace) return
515
516	catch {
517	if {$entrycmd($elem) == ""} return
518	incr expgui(changed)
519	if $expgui(debug) {puts "$entrycmd($elem) set $entryvar($elem) "}
520	if {$entrycmd($elem) == ""} return
521	if [catch {
522	set result [eval $entrycmd($elem) set [list $entryvar($elem)]]
523	if {!$result} {
524	if $expgui(debug) {puts "error with $entrycmd($elem)"}
525	catch {$entrybox($elem) config -fg red}
526	} else {
527	catch {$entrybox($elem) config -fg black}
528	}
529	if {[string match "*atominfo" [lindex $entrycmd($elem) 0]]} {
530	after idle "UpdateAtomLine \
531	[list [lindex $entrycmd($elem) 2]] \
532	[lindex $entrycmd($elem) 1]"
533	}
534	} errmsg] {error $errmsg}
535	}
536	}
537
538	# disable traces on entryvar until we are ready
539	set entrycmd(trace) 0
540	trace variable entryvar w entvartrace
541
542	#
543	#
544	#
545	##############################################################################
546	##### #####################################################
547	##### PROCEDURES SECTION #####################################################
548	##### #####################################################
549	##############################################################################
550
551	# save some of the global options in ~/.gsas_config or ~/gsas.config in Windows
552	proc SaveOptions {} {
553	global expgui env tcl_platform graph peakinfo
554	if {$tcl_platform(platform) == "windows"} {
555	set fp [open c:/gsas.config a]
556	} else {
557	set fp [open [file join ~ .gsas_config] a]
558	}
559
560	puts $fp "# EXPGUI saved options from [clock format [clock ticks]]"
561	foreach item {archive asorttype hsorttype filesort disaglSeparateBox \
562	font autoexpload autoiconify autotick autoGRWND} {
563	puts $fp "set expgui($item) [list $expgui($item)]"
564	}
565	if {$tcl_platform(platform) != "windows"} {
566	puts $fp "set env(GSASBACKSPACE) [list $env(GSASBACKSPACE)]"
567	}
568	foreach v {printout legend outname outcmd autoraise color_excl \
569	color_obs color_calc} {
570	puts $fp "set graph($v) [list $graph($v)]"
571	}
572	foreach v {obssym obssize exclsym exclsize} {
573	puts $fp "set peakinfo($v) [list $peakinfo($v)]"
574	}
575	close $fp
576	}
577
578	proc About { } {
579	global expgui expmap
580	tk_dialog .about {About...} \
581	"EXPGUI\n\
582	Jonathan Wasserman and Brian Toby\n\
583	NIST Center for Neutron Research\n\n\
584	2000, Not subject to copyright\n\n\
585	Revision [lindex $expgui(Revision) 1] (readexp.tcl [lindex $expmap(Revision) 1])\n\n\
586	Cite: B. H. Toby, EXPGUI, a graphical\n\
587	user interface for GSAS, J. Appl. Cryst.\n\
588	34, 210-21 (2001).
589	\n\n\
590	Generalized Structure Analysis System\n(GSAS)\n\
591	A. C. Larson and\n R. B. Von Dreele,\n LANSCE, Los Alamos\n\n\
592	" \
593	info 0 OK
594	}
595	proc Cite { } {
596	global expgui expmap
597	tk_dialog .about {Citations...} \
598	"If you use EXPGUI, please cite\n\n\
599	B.H. Toby, EXPGUI, a graphical\n\
600	user interface for GSAS, J. Appl. Cryst.\n\
601	34, 210-21 (2001).\n\n\
602	as well as\n\n\
603	A.C. Larson and R.B. Von Dreele,\n\
604	\"General Structure Analysis System (GSAS)\",\n\
605	Los Alamos National Laboratory Report\n\
606	LAUR 86-748 (2000)." \
607	info 0 OK
608	}
609
610	# this proc gets called when the export coordinate button is pressed
611	# it loads export
612	proc BuildCoordExpMenu {menu} {
613	global expgui_cmdlist expgui
614	# do this only once
615	$menu config -postcommand {}
616	$menu delete 1 end
617	# add the cif export routine
618	set cmd gsas2cif
619	set action {}
620	catch {set action [lindex $expgui_cmdlist($cmd) 0]}
621	if {$action != "" && $action != "-"} {
622	$menu add command -label $cmd -command [subst $action]
623	}
624	# get a list of files to read
625	set filelist [glob -nocomplain [file join $expgui(scriptdir) export_*.tcl]]
626	foreach file $filelist {
627	source $file
628	$menu add command -label $label -command $action
629	}
630	}
631
632	# utility export routines for the export_*.tcl files:
633	# make a box for export
634	proc MakeExportBox {win title webref} {
635	global expmap expgui
636	catch {destroy $win}
637	toplevel $win
638	wm title $win "Export coordinates"
639	if {$webref != ""} {
640	bind $win <Key-F1> $webref
641	}
642	pack [label $win.lbl -text $title] -side top -anchor center
643	pack [frame $win.ps] -side top -anchor w
644	pack [label $win.ps.lbl -text "Select phase: "] -side left
645	foreach num $expmap(phaselist) {
646	pack [button $win.ps.$num -text $num \
647	-command "SetExportPhase $num $win"] -side left
648	}
649	# leave a place for format-specific items
650	pack [frame $win.special] -side top
651	pack [frame $win.but] -side top -fill x -expand yes
652	pack [button $win.but.1 -text Write -command "destroy $win"] -side left
653	SetExportPhase [lindex $expmap(phaselist) 0] $win
654	pack [button $win.but.2 -text Quit \
655	-command "set expgui(export_phase) 0;destroy $win"] -side left
656	pack [button $win.but.help -text Help -bg yellow \
657	-command "MakeWWWHelp expgui.html ExportMSI"] \
658	-side right
659	}
660
661	# set the phase in response to the button
662	proc SetExportPhase {num win} {
663	global expmap expgui
664	foreach n $expmap(phaselist) {
665	if {$n == $num} {
666	$win.ps.$n config -relief sunken;
667	set expgui(export_phase) $num
668	} else {
669	$win.ps.$n config -relief raised
670	}
671	}
672	}
673
674	# wait until idle
675	proc afterawhile {} {
676	# cancel any other instances of this loop
677	after cancel afterawhile
678	after cancel whenidle
679	after cancel whenidle
680	after idle whenidle
681	}
682
683	# This is called every 2 seconds to check for changes to the .EXP file
684	proc whenidle {} {
685	global expgui tcl_platform
686	if $expgui(titleunchanged) {
687	if {$expgui(changed) != 0} {
688	wm title . "$expgui(expfile) (modified)"
689	set expgui(titleunchanged) 0
690	}
691	}
692	if {$expgui(expModifiedLast) == 0} {
693	after 2000 afterawhile
694	return
695	}
696	if {![file exists $expgui(expfile)]} {
697	after 2000 afterawhile
698	return
699	}
700	if {[file mtime $expgui(expfile)] != $expgui(expModifiedLast)} {
701	# we are "locked". Note that whenidle loop will be restarted later
702	if {$tcl_platform(platform) == "windows" && [file exists expgui.lck]} {
703	return
704	}
705	set ans [ReloadExpMsg [file tail $expgui(expfile)] $expgui(changed)]
706
707	if {$ans == 0} {
708	loadexp $expgui(expfile)
709	} elseif {$ans == 1} {
710	# reset the time to the next version
711	set expgui(expModifiedLast) [file mtime $expgui(expfile)]
712	} elseif {$ans == 2} {
713	SaveAsFile
714	}
715	}
716	after 2000 afterawhile
717	}
718
719	# place a message about changes over the main window
720	proc ReloadExpMsg {file changes} {
721	global expgui tcl_platform
722	set msg "File $file has been modified by another program"
723	if {$changes == 1} {
724	append msg " and you have made a change to this version.\n"
725	} elseif {$changes > 0} {
726	append msg " and you have made $changes changes to this version.\n"
727	} else {
728	append msg ".\n"
729	}
730	append msg "Do you want to use the newer (modified) version or continue with the older (previous) version of the file?"
731
732	set w .ask
733	catch {destroy $w}
734	toplevel $w -class Dialog
735	wm title $w "Reload?"
736	wm iconname $w "Reload?"
737	wm protocol $w WM_DELETE_WINDOW { }
738	wm transient $w .
739	bind $w <Key-F1> "MakeWWWHelp expguierr.html Overwrite"
740	pack [button $w.help -text Help -bg yellow \
741	-command "MakeWWWHelp expguierr.html Overwrite"] \
742	-side top -anchor e
743	frame $w.bot
744	pack $w.bot -side bottom
745	frame $w.top -class FixedFont
746	pack $w.top -side top -fill both -expand 1
747	label $w.top.msg -justify left \
748	-wraplength 5i -font {Times 18} \
749	-text $msg
750	if {$tcl_platform(platform) == "windows"} {
751	$w.top.msg config -font {Times 14}
752	}
753	pack $w.top.msg -side right -expand 1 -fill both -padx 3m -pady 3m
754	pack [button $w.bot.1 -text "Load new" \
755	-default active -command "set expgui(dialogbutton) 0" \
756	] -side left -expand 1 -padx 3m -pady 2m
757	pack [button $w.bot.2 -text "Continue with old" \
758	-command "set expgui(dialogbutton) 1"] \
759	-side left -expand 1 -padx 3m -pady 2m
760	if {$changes > 0} {
761	pack [button $w.bot.3 -text "Save edited version" \
762	-command "set expgui(dialogbutton) 2"] \
763	-side left -expand 1 -padx 3m -pady 2m
764	}
765	# Create a binding for <Return> on the dialog
766	bind $w <Return> "tkButtonInvoke $w.bot.1"
767	wm withdraw $w
768	update idletasks
769
770	# for windows put the box in the upper left, for
771	# unix center it over the parent (in unix it appears later)
772	#if {$tcl_platform(platform) == "windows"} {
773	#wm geom $w +0+0
774	#} else {
775
776	# for now, always center the message over the main window
777	# center the new window in the middle of the parent
778	set x [expr [winfo x .] + [winfo width .]/2 - \
779	[winfo reqwidth $w]/2 - [winfo vrootx .]]
780	set y [expr [winfo y .] + [winfo height .]/2 - \
781	[winfo reqheight $w]/2 - [winfo vrooty .]]
782	wm geom $w +$x+$y
783	#}
784	wm deiconify $w
785
786	# Grab the focus
787	set oldFocus [focus]
788	set oldGrab [grab current $w]
789	if {[string compare $oldGrab ""]} {
790	set grabStatus [grab status $oldGrab]
791	}
792	catch {grab $w}
793	focus $w.bot.1
794	# for windows rearrange window stacking
795	# -- Removed since this will normally happen after the GSAS program
796	# has finished
797	#if {$tcl_platform(platform) == "windows"} {
798	#lower .
799	#raise $w .
800	#}
801	update idletasks
802
803	tkwait variable expgui(dialogbutton)
804	catch {focus $oldFocus}
805	destroy $w
806	if {[string compare $oldGrab ""]} {
807	if {![string compare $grabStatus "global"]} {
808	catch {grab -global $oldGrab}
809	} else {
810	catch {grab $oldGrab}
811	}
812	}
813	# for windows rearrange window stacking
814	#if {$tcl_platform(platform) == "windows"} {
815	#raise .
816	#}
817	return $expgui(dialogbutton)
818	}
819
820	# -------- called to confirm before exiting
821	proc catchQuit {} {
822	if {[confirmBeforeSave] == "Continue"} {
823	destroy .
824	}
825	}
826	# save the .EXP file before exiting?
827	proc confirmBeforeSave {} {
828	global expgui
829	if !$expgui(changed) {
830	return "Continue"
831	}
832	set decision [tk_dialog .instrSaveData {Save .EXP changes} \
833	{You have made changes to the Experiment, but the changes are not saved. Select an option:} \
834	{} 0 "Save and Exit" "Exit without Save" "Cancel exit command"]
835	switch $decision {
836	0 { savearchiveexp; return "Continue" }
837	1 { return "Continue" }
838	2 { return "Cancel" }
839	}
840	}
841
842	# setup buttons for each phase on the phase page
843	proc setphases {} {
844	global expgui expmap
845	eval destroy [winfo children $expgui(phaseFrame).top.ps]
846	pack [label $expgui(phaseFrame).top.ps.0 -text Phase:] -side left
847	foreach num $expmap(phaselist) {
848	pack [button $expgui(phaseFrame).top.ps.$num -text $num \
849	-command "SelectOnePhase $num" -padx 1.5m] -side left
850	}
851	if {[file executable $expgui(exptool)] && \
852	[llength $expmap(phaselist)]} {
853	pack [button $expgui(phaseFrame).top.ps.10 \
854	-text "Replace" -command MakeReplacePhaseBox \
855	] -side left
856	}
857	}
858
859	# Procedure to respond to changes the phase.
860	# This loads the "phases" widgets with data corresponding to the selected phase.
861	proc SelectOnePhase {num} {
862	global entryvar entrycmd entrybox expmap expgui
863	# if no phase has been selected, select the first one
864	if {$num == ""} {set num [lindex $expmap(phaselist) 0]}
865
866	set crsPhase {}
867	$expgui(atomxform) config -text "Xform Atoms" -state disabled
868	foreach n $expmap(phaselist) type $expmap(phasetype) {
869	if {$n == $num} {
870	catch {$expgui(phaseFrame).top.ps.$num config -relief sunken}
871	set crsPhase $num
872	if {$type == 3} {
873	set expgui(phasetype) "Magnetic\nOnly"
874	} elseif {$type == 2} {
875	set expgui(phasetype) "Magnetic\n& Nuclear"
876	} elseif {$type == 4} {
877	set expgui(phasetype) "Macromolecular"
878	} else {
879	set expgui(phasetype) ""
880	}
881	} else {
882	catch {$expgui(phaseFrame).top.ps.$n config -relief raised}
883	}
884	}
885	# no phase is selected
886	if {$crsPhase == "" \|\| [llength $expmap(phaselist)] == 0} {
887	# disable traces on entryvar
888	set entrycmd(trace) 0
889	set entrycmd(phasename) ""
890	set entryvar(phasename) ""
891	foreach ent {a b c alpha beta gamma} {
892	set entryvar($ent) ""
893	}
894	foreach ent {cellref celldamp} {
895	set entrycmd($ent) ""
896	set entryvar($ent) ""
897	}
898	set expgui(curPhase) {}
899	# enable traces on entryvar
900	set entrycmd(trace) 1
901	$expgui(EditingAtoms) config -text ""
902	DisplayAtom 0 0
903	DisplayU 0 0
904	DisplayRefFlags 0 0
905	$expgui(atomlistbox) delete 0 end
906	return
907	}
908
909	# don't reload the last displayed phase
910	if {$expgui(curPhase) == $crsPhase} return
911
912	##########################################################
913	# load and display a phase
914	##########################################################
915	# disable traces on entryvar while loading
916	set entrycmd(trace) 0
917	# phase title
918	set entrycmd(phasename) "phaseinfo $crsPhase name"
919	set entryvar(phasename) [phaseinfo $crsPhase name]
920	# cell parameters & flags
921	foreach ent {a b c alpha beta gamma} {
922	set entryvar($ent) [phaseinfo $crsPhase $ent]
923	}
924	foreach ent {cellref celldamp} {
925	set entrycmd($ent) "phaseinfo $crsPhase $ent"
926	set entryvar($ent) [phaseinfo $crsPhase $ent]
927	}
928
929	# initialize atoms display & disable
930	DisplayAtom 0 0
931	DisplayU 0 0
932	DisplayRefFlags 0 0
933	$expgui(EditingAtoms) config -text ""
934
935	DisplayAllAtoms $crsPhase
936
937	# enable traces on entryvar now
938	set entrycmd(trace) 1
939	}
940
941	set expgui(noreenterDisplayAllAtoms) 0
942	# Populate expgui(atomlistbox) (a ScrolledListBox) with atoms
943	# from the selected phase.
944	proc DisplayAllAtoms {curPhase "mode reset"} {
945	global entryvar entrycmd expmap expgui
946	# if it does not show, we don't have a phase or we are already displaying
947	# don't bother
948	if {$expgui(pagenow) != "phaseFrame"} return
949	if {$curPhase == ""} return
950	if $expgui(noreenterDisplayAllAtoms) return
951	# prevent reentry
952	set expgui(noreenterDisplayAllAtoms) 1
953	# set the current phase
954	set expgui(curPhase) $curPhase
955	if {$mode != "reset"} {
956	# save the scrolled position
957	set pos [lindex [$expgui(atomlistbox) yview] 0]
958	} else {
959	# for reset, do not keep the previously selected atoms
960	set expgui(selectedatomlist) {}
961	}
962	$expgui(atomlistbox) delete 0 end
963	# displaying a macromolecular phase?
964	if {[lindex $expmap(phasetype) [expr {$expgui(curPhase) - 1}]] == 4} {
965	set mm 1
966	$expgui(phaseFrame).top.ps.10 config -state disabled
967	$expgui(AddAtomBut) config -state disabled
968	pleasewait "loading atoms..."
969	} else {
970	set mm 0
971	if {[file executable $expgui(exptool)]} {
972	$expgui(phaseFrame).top.ps.10 config -state normal
973	$expgui(AddAtomBut) config -state normal
974	}
975	}
976
977	# prepare header info
978	set maxline I
979	set phase $expgui(curPhase)
980	set atomlist {}
981	set typehead "type "
982	set namehead " name "
983	set multhead "Mult"
984	set coordhead " "
985	if {$mm} {
986	set cmd mmatominfo
987	set frachead "Occ."
988	} else {
989	set cmd atominfo
990	set frachead "Occupancy"
991	}
992	set reshead "res/grp/#"
993	# sort the atoms, as requested
994	if {$expgui(asorttype) == "type"} {
995	# sort on atom type
996	set typehead "type* "
997	foreach atom $expmap(atomlist_$phase) {
998	lappend atomlist "$atom [$cmd $phase $atom type] $phase"
999	}
1000	set expmap(atomlistboxcontents) [lsort -ascii -index 1 $atomlist]
1001	} elseif {$expgui(asorttype) == "number"} {
1002	# sort on atom number
1003	set namehead "* name "
1004	foreach atom $expmap(atomlist_$phase) {
1005	lappend atomlist "$atom $atom $phase"
1006	}
1007	set expmap(atomlistboxcontents) [lsort -integer -index 1 $atomlist]
1008	} elseif {$expgui(asorttype) == "mult"} {
1009	if {$mm} {
1010	set reshead "res*/grp/#"
1011	foreach atom $expmap(atomlist_$phase) {
1012	lappend atomlist "$atom [mmatominfo $phase $atom residue] $phase"
1013	}
1014	set expmap(atomlistboxcontents) [lsort -ascii -index 1 $atomlist]
1015	} else {
1016	# sort on atom number
1017	set multhead "Mlt*"
1018	foreach atom $expmap(atomlist_$phase) {
1019	lappend atomlist "$atom [atominfo $phase $atom mult] $phase"
1020	}
1021	set expmap(atomlistboxcontents) [lsort -integer -decreasing -index 1 $atomlist]
1022	}
1023	} elseif {$expgui(asorttype) == "occupancy"} {
1024	# sort on atom number
1025	if {$mm} {
1026	set frachead " Occ* "
1027	} else {
1028	set frachead " Occup* "
1029	}
1030	foreach atom $expmap(atomlist_$phase) {
1031	lappend atomlist "$atom [$cmd $phase $atom frac] $phase"
1032	}
1033	set expmap(atomlistboxcontents) [lsort -real -decreasing -index 1 $atomlist]
1034	} elseif {$expgui(asorttype) == "x"} {
1035	# sort on x
1036	set coordhead "(x*)"
1037	foreach atom $expmap(atomlist_$phase) {
1038	lappend atomlist "$atom [$cmd $phase $atom x] $phase"
1039	}
1040	set expmap(atomlistboxcontents) [lsort -real -index 1 $atomlist]
1041	} elseif {$expgui(asorttype) == "y"} {
1042	# sort on y
1043	set coordhead "(y*)"
1044	foreach atom $expmap(atomlist_$phase) {
1045	lappend atomlist "$atom [$cmd $phase $atom y] $phase"
1046	}
1047	set expmap(atomlistboxcontents) [lsort -real -index 1 $atomlist]
1048	} elseif {$expgui(asorttype) == "z"} {
1049	# sort on z
1050	set coordhead "(z*)"
1051	foreach atom $expmap(atomlist_$phase) {
1052	lappend atomlist "$atom [$cmd $phase $atom z] $phase"
1053	}
1054	set expmap(atomlistboxcontents) [lsort -real -index 1 $atomlist]
1055	} else {
1056	error "Bad expgui(asorttype) = $expgui(asorttype)"
1057	}
1058
1059	set expgui(atomlistboxline) {}
1060	# loop over atoms
1061	foreach tuple $expmap(atomlistboxcontents) {
1062	set atom [lindex $tuple 0]
1063	set phase [lindex $tuple 2]
1064	lappend expgui(atomlistboxline) $atom
1065	$expgui(atomlistbox) insert end \
1066	[FormatAtomLine $atom $phase maxline]
1067	}
1068	$expgui(atomtitle) delete 0 end
1069
1070	# create the header
1071	if {$mm} {
1072	$expgui(atomtitle) insert end [format "%12s %9s %6s %8s%29s %4s %s" \
1073	$namehead $reshead $typehead "ref/damp " \
1074	"fractional coordinates$coordhead" \
1075	"$frachead" \
1076	" Uiso"]
1077	donewait
1078	} elseif {$maxline == "A"} {
1079	$expgui(atomtitle) insert end [format "%10s %6s %8s%29s %9s %s" \
1080	$namehead $typehead "ref/damp " \
1081	"fractional coordinates$coordhead" \
1082	"$multhead $frachead" \
1083	" Uiso/Uij "]
1084	} else {
1085	$expgui(atomtitle) insert end [format "%10s %6s %8s%29s %9s %s" \
1086	$namehead $typehead "ref/damp " \
1087	"fractional coordinates$coordhead" \
1088	"$multhead $frachead" \
1089	" Uiso"]
1090	}
1091	if {$mode != "reset"} {
1092	# restore the selected items
1093	foreach i $expgui(selectedatomlist) {
1094	$expgui(atomlistbox) selection set $i
1095	}
1096	# restore the last scrolled position
1097	$expgui(atomlistbox) yview moveto $pos
1098	}
1099	# clear the reentry flag
1100	set expgui(noreenterDisplayAllAtoms) 0
1101	}
1102
1103	proc FormatAtomLine {atom phase maxline_var} {
1104	global expmap
1105	if {[lindex $expmap(phasetype) [expr {$phase - 1}]] == 4} {
1106	foreach type {x u f} {
1107	if {[mmatominfo $phase $atom ${type}ref]} {
1108	append refflag "[string toupper $type][mmatominfo $phase $atom ${type}damp] "
1109	} else {
1110	append refflag " [mmatominfo $phase $atom ${type}damp] "
1111	}
1112	}
1113	set line [format \
1114	"%5d %-6s %-3s%-2s%4d %-6s %8s %9.5f%9.5f%9.5f%8.4f %7.4f" \
1115	$atom \
1116	[mmatominfo $phase $atom label] \
1117	[mmatominfo $phase $atom residue] \
1118	[mmatominfo $phase $atom group] \
1119	[mmatominfo $phase $atom resnum] \
1120	[mmatominfo $phase $atom type] \
1121	$refflag \
1122	[mmatominfo $phase $atom x] \
1123	[mmatominfo $phase $atom y] \
1124	[mmatominfo $phase $atom z] \
1125	[mmatominfo $phase $atom frac] \
1126	[mmatominfo $phase $atom Uiso]
1127	]
1128	} elseif {[atominfo $phase $atom temptype] == "A"} {
1129	foreach type {x u f} {
1130	if {[atominfo $phase $atom ${type}ref]} {
1131	append refflag "[string toupper $type][atominfo $phase $atom ${type}damp] "
1132	} else {
1133	append refflag " [atominfo $phase $atom ${type}damp] "
1134	}
1135	}
1136	# want to set maxline in parent
1137	upvar $maxline_var maxline
1138	set maxline A
1139	# aniso
1140	set line [format "%3d %-6s %-6s %8s %10.6f%10.6f%10.6f%4d%9.4f" \
1141	$atom \
1142	[atominfo $phase $atom label] \
1143	[atominfo $phase $atom type] \
1144	$refflag \
1145	[atominfo $phase $atom x] \
1146	[atominfo $phase $atom y] \
1147	[atominfo $phase $atom z] \
1148	[atominfo $phase $atom mult] \
1149	[atominfo $phase $atom frac]
1150	]
1151	append line [format " %9.5f%9.5f%9.5f%9.5f%9.5f%9.5f" \
1152	[atominfo $phase $atom U11] \
1153	[atominfo $phase $atom U22] \
1154	[atominfo $phase $atom U33] \
1155	[atominfo $phase $atom U12] \
1156	[atominfo $phase $atom U23] \
1157	[atominfo $phase $atom U13]
1158	]
1159	} else {
1160	foreach type {x u f} {
1161	if {[atominfo $phase $atom ${type}ref]} {
1162	append refflag "[string toupper $type][atominfo $phase $atom ${type}damp] "
1163	} else {
1164	append refflag " [atominfo $phase $atom ${type}damp] "
1165	}
1166	}
1167	set line [format \
1168	"%3d %-6s %-6s %8s %10.6f%10.6f%10.6f%4d%9.4f %9.5f" \
1169	$atom \
1170	[atominfo $phase $atom label] \
1171	[atominfo $phase $atom type] \
1172	$refflag \
1173	[atominfo $phase $atom x] \
1174	[atominfo $phase $atom y] \
1175	[atominfo $phase $atom z] \
1176	[atominfo $phase $atom mult] \
1177	[atominfo $phase $atom frac] \
1178	[atominfo $phase $atom Uiso]
1179	]
1180	}
1181	return $line
1182	}
1183
1184	# update the display of atom as they are changed
1185	proc UpdateAtomLine {atomlist phase} {
1186	global expgui
1187	# for lots of atoms, it is faster to repaint the listbox
1188	if {[llength $atomlist] > 25} {
1189	DisplayAllAtoms $expgui(curPhase) noreset
1190	return
1191	}
1192	foreach atom $atomlist {
1193	set linenum [lsearch -exact $expgui(atomlistboxline) $atom]
1194	$expgui(atomlistbox) delete $linenum
1195	$expgui(atomlistbox) insert $linenum \
1196	[FormatAtomLine $atom $phase maxline]
1197	}
1198	# restore the selected items
1199	foreach i $expgui(selectedatomlist) {
1200	$expgui(atomlistbox) selection set $i
1201	}
1202	}
1203
1204	# Procedure to select all atoms in response to a right-click
1205	proc SelectAllAtoms {} {
1206	global expgui
1207	$expgui(atomlistbox) selection set 0 end
1208	# call editRecord in case trace was called before the selection was made
1209	editRecord
1210	}
1211
1212	# Procedure to respond to left mouse release in the atoms Pane
1213	proc editRecord { args } {
1214	global entrycmd expgui
1215	set expgui(selectedatomlist) [$expgui(atomlistbox) curselection]
1216	# disable traces on entryvar for right now
1217	set entrycmd(trace) 0
1218
1219	if {[llength $expgui(selectedatomlist)] == 0} {
1220	if $expgui(debug) {error "Attempt display non-existent atoms"}
1221	} elseif {[llength $expgui(selectedatomlist)] == 1} {
1222	editOneRecord $expgui(selectedatomlist)
1223	} else {
1224	editMultipleRecords $expgui(selectedatomlist)
1225	}
1226	# reenable traces on entryvar
1227	set entrycmd(trace) 1
1228	# repaint the atoms box in case anything was changed
1229	# DisplayAllAtoms noreset
1230	}
1231
1232	proc editOneRecord { AtomIndex } {
1233	global expmap expgui
1234	# get atom number & phase
1235	set tuple [lindex $expmap(atomlistboxcontents) $AtomIndex]
1236	set atomnum [lindex $tuple 0]
1237	set p [lindex $tuple 2]
1238	DisplayU $atomnum $p
1239	DisplayAtom $atomnum $p
1240	DisplayRefFlags $atomnum $p
1241	$expgui(EditingAtoms) config -text "Editing atom #$atomnum -- [atominfo $p $atomnum label]"
1242	$expgui(atomxform) config -text "Xform Atom" -state normal
1243	}
1244
1245	# this will not work for a multi-phase list of atoms (yet)
1246	proc editMultipleRecords { AtomIndexList } {
1247	global expmap expgui
1248	set numberList {}
1249	# current phase
1250	set p $expgui(curPhase)
1251	foreach AtomIndex $AtomIndexList {
1252	# get atom number & phase
1253	set tuple [lindex $expmap(atomlistboxcontents) $AtomIndex]
1254	lappend numberList [lindex $tuple 0]
1255	# set p [lindex $tuple 2]
1256	}
1257	# this needs to track by phase
1258	$expgui(EditingAtoms) config -text \
1259	"Set refinement options: atoms [CompressList $numberList]"
1260	DisplayU 0 0
1261	DisplayAtom 0 0
1262	# this needs to track by phase
1263	DisplayRefFlags $numberList $p
1264	$expgui(atomxform) config -text "Xform Atoms" -state normal
1265	}
1266
1267	# format a string of numbers to save space, e.g. "1 2 3 4 6 7 19 13 14 15"
1268	# becomes "1-4,6,7,13-15,19"
1269	proc CompressList {numberList "max 9999"} {
1270	# format the number list to save space
1271	set lastnum -99
1272	set flist {}
1273	set count 0
1274	set length 0
1275	if [catch {set sortlist [lsort -integer $numberList]}] {return $numberList}
1276	foreach num $sortlist {
1277	set next [expr $lastnum+1]
1278	if {$num != $next} {
1279	if {$count == 0 && $flist != ""} {
1280	if {[string length $flist] - $length > $max} {
1281	set length [string length $flist]
1282	append flist ",\n$num"
1283	} else {
1284	append flist ",$num"
1285	}
1286	} elseif {$count == 1 && $flist != ""} {
1287	if {[string length $flist] - $length > $max} {
1288	set length [string length $flist]
1289	append flist ",$lastnum,\n$num"
1290	} else {
1291	append flist ",$lastnum,$num"
1292	}
1293	} elseif {$flist != ""} {
1294	if {[string length $flist] - $length > $max} {
1295	set length [string length $flist]
1296	append flist "-$lastnum,\n$num"
1297	} else {
1298	append flist "-$lastnum,$num"
1299	}
1300	} else {
1301	append flist "$num"
1302	}
1303	set lastnum $num
1304	set count 0
1305	} else {
1306	incr count
1307	incr lastnum
1308	}
1309	}
1310	if {$count == 1 && $flist != ""} {
1311	append flist ",$lastnum"
1312	} elseif {$flist != "" && $count > 1} {
1313	append flist "-$lastnum"
1314	}
1315	return $flist
1316	}
1317
1318	# Procedure to display Isotropic or Anisotropic temperature factors
1319	# Changes the display to one entry widget for Isotropic motion OR
1320	# 6 entry widgets for Anisotropic motion in Frame3.
1321	# or disables the widet entirly if atom = 0
1322	proc DisplayU { atomnum p} {
1323	global expgui entryvar entrycmd expmap
1324	set mm 0
1325	if {$atomnum == 0} {
1326	set iOrA disable
1327	} elseif {[lindex $expmap(phasetype) 0] == 4} {
1328	set mm 1
1329	set iOrA I
1330	} else {
1331	set iOrA [atominfo $p $atomnum temptype]
1332	}
1333
1334	set firstbox [lindex $expgui(anisolabels) 0]
1335	if { $iOrA == "A" } {
1336	$firstbox config -text "U11 "
1337	foreach item $expgui(anisolabels) {
1338	$item config -fg black
1339	}
1340	foreach item $expgui(anisoentry) var {U11 U22 U33 U12 U13 U23} {
1341	set entrycmd($var) "atominfo $p $atomnum $var"
1342	set entryvar($var) [eval $entrycmd($var)]
1343	$item config -fg black -state normal -bg white
1344	}
1345	} elseif { $iOrA == "I" \|\| $iOrA == "disable"} {
1346	foreach item $expgui(anisolabels) {
1347	$item config -fg $expgui(bkgcolor1)
1348	}
1349	foreach item [lrange $expgui(anisoentry) 1 end] \
1350	var {U22 U33 U12 U13 U23} {
1351	set entrycmd($var) ""
1352	set entryvar($var) ""
1353	$item config -fg $expgui(bkgcolor1) -bg $expgui(bkgcolor1) \
1354	-state disabled
1355	}
1356	if { $iOrA == "disable"} {
1357	set entrycmd($var) ""
1358	set entryvar($var) ""
1359	[lindex $expgui(anisoentry) 0] config \
1360	-fg $expgui(bkgcolor1) -bg $expgui(bkgcolor1) \
1361	-state disabled
1362	} elseif {$mm} {
1363	set entrycmd(U11) "mmatominfo $p $atomnum Uiso"
1364	set entryvar(U11) [eval $entrycmd(U11)]
1365	$firstbox config -text Uiso -fg black
1366	[lindex $expgui(anisoentry) 0] config -fg black -bg white -state normal
1367	} else {
1368	set entrycmd(U11) "atominfo $p $atomnum Uiso"
1369	set entryvar(U11) [eval $entrycmd(U11)]
1370	$firstbox config -text Uiso -fg black
1371	[lindex $expgui(anisoentry) 0] config -fg black -bg white -state normal
1372	}
1373	}
1374	}
1375
1376	# need to think about multiple phases
1377
1378	# Procedure to display refinement flags
1379	proc DisplayRefFlags { atomnum p} {
1380	global expgui entryvar entrycmd expmap
1381	if {$atomnum == 0} {
1382	foreach label $expgui(atomreflbl) {
1383	$label config -fg $expgui(bkgcolor1)
1384	}
1385	foreach entry $expgui(atomref) {
1386	$entry config -state disabled \
1387	-fg $expgui(bkgcolor1) -bg $expgui(bkgcolor1)
1388	# turn off checkbuttons
1389	catch {$entry deselect}
1390
1391	}
1392	return
1393	}
1394	foreach label $expgui(atomreflbl) {
1395	$label config -fg black
1396	}
1397	foreach entry $expgui(atomref) {
1398	$entry config -state normal -fg black -bg $expgui(bkgcolor1)
1399	}
1400	if {[lindex $expmap(phasetype) 0] == 4} {
1401	foreach var {xref uref fref xdamp udamp fdamp} {
1402	set entrycmd($var) "mmatominfo $p [list $atomnum] $var"
1403	set entryvar($var) [eval $entrycmd($var)]
1404	}
1405	} else {
1406	foreach var {xref uref fref xdamp udamp fdamp} {
1407	set entrycmd($var) "atominfo $p [list $atomnum] $var"
1408	set entryvar($var) [eval $entrycmd($var)]
1409	}
1410	}
1411	}
1412
1413	# Procedure to display an atom in the atom edit boxes
1414	proc DisplayAtom { atomnum p} {
1415	global expgui entryvar entrycmd expmap
1416	if {$atomnum == 0} {
1417	foreach label $expgui(atomlabels) {
1418	$label config -fg $expgui(bkgcolor1)
1419	}
1420	foreach entry $expgui(atomentry) {
1421	$entry config -state disabled \
1422	-fg $expgui(bkgcolor1) -bg $expgui(bkgcolor1)
1423	}
1424	return
1425	}
1426	foreach label $expgui(atomlabels) {
1427	$label config -fg black
1428	}
1429	foreach entry $expgui(atomentry) {
1430	$entry config -state normal -fg black -bg white
1431	}
1432	if {[lindex $expmap(phasetype) 0] == 4} {
1433	foreach var {x y z label frac } {
1434	set entrycmd($var) "mmatominfo $p $atomnum $var"
1435	set entryvar($var) [eval $entrycmd($var)]
1436	}
1437	} else {
1438	foreach var {x y z label frac } {
1439	set entrycmd($var) "atominfo $p $atomnum $var"
1440	set entryvar($var) [eval $entrycmd($var)]
1441	}
1442	}
1443	}
1444
1445	# make a histogram box; used in MakeHistPane,
1446	proc MakeHistBox {frm} {
1447	global expgui
1448	grid [label $frm.mode -text "Select a Histogram" \
1449	-bg beige -anchor center] \
1450	-row 0 -column 0 -columnspan 2 -sticky ew
1451	bind $frm.mode <Button-1> {
1452	set i [lsearch $expgui(AllowedHistSelectModes) $expgui(globalmode)]
1453	set expgui(globalmode) [lindex \
1454	"$expgui(AllowedHistSelectModes) \
1455	$expgui(AllowedHistSelectModes)" [incr i]]
1456	sethistlist
1457	}
1458	bind $frm.mode <Button-3> {set expgui(globalmode) 0; sethistlist}
1459	grid [listbox $frm.title -height 1 -relief flat \
1460	-exportselection 0 ] -row 1 -column 0 -sticky ew
1461	grid [listbox $frm.lbox -height 10 -width 25 \
1462	-exportselection 0 \
1463	-xscrollcommand "$frm.x set" \
1464	-yscrollcommand "$frm.y set" \
1465	] -row 2 -column 0 -sticky news
1466	lappend expgui(HistSelectList) $frm
1467	grid [scrollbar $frm.x -orient horizontal \
1468	-command "move2boxesX \" $frm.title $frm.lbox \" "
1469	] -row 3 -column 0 -sticky ew
1470	grid [scrollbar $frm.y \
1471	-command "$frm.lbox yview"] \
1472	-row 2 -column 1 -sticky ns
1473	grid columnconfigure $frm 0 -weight 1
1474	grid rowconfigure $frm 2 -weight 1
1475	}
1476
1477	# update the histogram list
1478	# to do: show histogram ref flags?
1479	proc sethistlist {} {
1480	global expgui expmap
1481	array set lbl {
1482	1 "Select 1 or more\nTOF Histograms"
1483	2 "Select 1 or more\nCW Neutron Histograms"
1484	3 "Select 1 or more\nAlpha 1,2 X-ray Histograms"
1485	4 "Select 1 or more\nmonochromatic X-ray Histograms"
1486	5 "Select 1 or more Energy\nDispersive X-ray Histograms"
1487	6 "Select 1 or more of\n any type Histograms"
1488	}
1489	foreach lbox $expgui(HistSelectList) {
1490	$lbox.title delete 0 end
1491	$lbox.lbox delete 0 end
1492	if {$expgui(globalmode) != 0} {
1493	$lbox.lbox config -selectmode extended
1494	$lbox.mode config -text $lbl($expgui(globalmode)) -bg yellow
1495	} else {
1496	$lbox.lbox config -selectmode browse
1497	$lbox.mode config -text "Select a histogram" -bg beige
1498	}
1499	}
1500	# disable the unallowed pages in all mode
1501	if {$expgui(globalmode) == 6} {
1502	foreach pair $expgui(GlobalModeAllDisable) {
1503	if {$expgui(pagenow) == [lindex $pair 0]} {
1504	RaisePage lsFrame
1505	}
1506	eval [lindex $pair 1] -state disabled
1507	}
1508	} else {
1509	foreach pair $expgui(GlobalModeAllDisable) {
1510	eval [lindex $pair 1] -state normal
1511	}
1512	}
1513	set histlist {}
1514	if {$expgui(hsorttype) == "type"} {
1515	# sort on histogram type
1516	foreach h [lsort -integer -increasing $expmap(powderlist)] {
1517	lappend histlist "$h [string range $expmap(htype_$h) 1 2]"
1518	}
1519	set expmap(histlistboxcontents) [lsort -ascii -index 1 $histlist]
1520	} elseif {$expgui(hsorttype) == "number"} {
1521	# sort on histogram number
1522	foreach h [lsort -integer -increasing $expmap(powderlist)] {
1523	lappend histlist "$h $h"
1524	}
1525	set expmap(histlistboxcontents) [lsort -integer -index 1 $histlist]
1526	} elseif {$expgui(hsorttype) == "bank"} {
1527	# sort on original bank number
1528	foreach h [lsort -integer -increasing $expmap(powderlist)] {
1529	lappend histlist "$h [histinfo $h bank]"
1530	}
1531	set expmap(histlistboxcontents) [lsort -integer -index 1 $histlist]
1532	} elseif {$expgui(hsorttype) == "angle"} {
1533	# sort on wavelength (CW) or angle (E disp.)
1534	foreach h [lsort -integer -increasing $expmap(powderlist)] {
1535	if {[string range $expmap(htype_$h) 2 2] == "T"} {
1536	set det [format %8.2f [histinfo $h tofangle]]
1537	} elseif {[string range $expmap(htype_$h) 2 2] == "C"} {
1538	set det [format %8.5f [histinfo $h lam1]]
1539	} elseif {[string range $expmap(htype_$h) 2 2] == "E"} {
1540	set det [format %8.2f [histinfo $h lam1]]
1541	} else {
1542	set det {}
1543	}
1544	lappend histlist "$h $det"
1545	}
1546	set expmap(histlistboxcontents) [lsort -real -index 1 $histlist]
1547	}
1548
1549	# title field needs to match longest title
1550	foreach lbox $expgui(HistSelectList) {
1551	$lbox.title insert end [format "%2s %s %4s %8s %-67s" \
1552	"h#" \
1553	type \
1554	bank \
1555	"ang/wave" \
1556	" title" \
1557	]
1558	}
1559	foreach tuple $expmap(histlistboxcontents) {
1560	set h [lindex $tuple 0]
1561
1562	if {$expgui(globalmode) == 1} {
1563	if {[string range $expmap(htype_$h) 2 2] != "T"} continue
1564	} elseif {$expgui(globalmode) == 2} {
1565	if {[string range $expmap(htype_$h) 1 2] != "NC"} continue
1566	} elseif {$expgui(globalmode) == 3} {
1567	if {[string range $expmap(htype_$h) 1 2] != "XC" \|\| \
1568	[histinfo $h lam2] == 0.0} continue
1569	} elseif {$expgui(globalmode) == 4} {
1570	if {[string range $expmap(htype_$h) 1 2] != "XC" \|\| \
1571	[histinfo $h lam2] != 0.0} continue
1572	} elseif {$expgui(globalmode) == 5} {
1573	if {[string range $expmap(htype_$h) 1 2] != "XE"} continue
1574	}
1575
1576	if {[string range $expmap(htype_$h) 2 2] == "T"} {
1577	set det [format %8.2f [histinfo $h tofangle]]
1578	} elseif {[string range $expmap(htype_$h) 2 2] == "C"} {
1579	set det [format %8.5f [histinfo $h lam1]]
1580	} elseif {[string range $expmap(htype_$h) 2 2] == "E"} {
1581	set det [format %8.2f [histinfo $h lam1]]
1582	} else {
1583	set det {}
1584	}
1585	foreach lbox $expgui(HistSelectList) {
1586	$lbox.lbox insert end [format "%2d %s %4d %8s %-67s" \
1587	$h \
1588	[string range $expmap(htype_$h) 1 3] \
1589	[histinfo $h bank] \
1590	$det \
1591	[string range [histinfo $h title] 0 66] \
1592	]
1593	}
1594	}
1595	UpdateCurrentPage
1596	}
1597
1598	proc UpdateCurrentPage {} {
1599	global expgui
1600	foreach set $expgui(frameactionlist) {
1601	if {$expgui(pagenow) == [lindex $set 0]} {catch [lindex $set 1]}
1602	}
1603	}
1604
1605	#-----------------------------------------------------------------------
1606	# ----------- draw Histogram page
1607	#-----------------------------------------------------------------------
1608	proc DisplayHistogram {} {
1609	global expgui entrycmd entryvar entrybox expmap
1610
1611	# trap if more than one histogram is selected unless global mode
1612	if {$expgui(globalmode) == 0 && [llength $expgui(curhist)] > 1} {
1613	set expgui(curhist) [lindex $expgui(curhist) 0]
1614	}
1615
1616	# disable the add histogram button if no phases are present
1617	catch {
1618	foreach c [winfo children $expgui(histFrame).bb] {
1619	if {[llength $expmap(phaselist)] == 0} {
1620	$c configure -state disabled
1621	} else {
1622	$c configure -state normal
1623	}
1624	}
1625	}
1626
1627	# display the selected histograms
1628	$expgui(histFrame).hs.lbox selection clear 0 end
1629	foreach h $expgui(curhist) {
1630	$expgui(histFrame).hs.lbox selection set $h
1631	}
1632
1633	# disable traces on entryvar for right now
1634	set entrycmd(trace) 0
1635
1636	# get histogram list
1637	set histlist {}
1638	foreach item $expgui(curhist) {
1639	lappend histlist [lindex $expmap(powderlist) $item]
1640	}
1641	# must have at least one histogram selected here
1642	if {[llength $histlist] == 0} {
1643	set expgui(backtermlbl) ""
1644	set expgui(backtypelbl) ""
1645	foreach var {bref bdamp absref absdamp} {
1646	set entrycmd($var) ""
1647	set entryvar($var) ""
1648	}
1649	$expgui(histFrame).top.txt config -text "No Selected Histograms"
1650	grid $expgui(histFrame).top -column 1 -row 0 -sticky nsew
1651	set expgui(bkglbl) ""
1652	set expgui(abslbl) ""
1653	eval destroy [winfo children $expgui(diffBox)]
1654	set entrycmd(trace) 1
1655	return
1656	}
1657
1658	if {$expgui(globalmode) != 0} {
1659	set expgui(backtermlbl) ""
1660	set expgui(backtypelbl) ""
1661	foreach var {bref bdamp absref absdamp} {
1662	set entrycmd($var) "histinfo [list $histlist] $var"
1663	set entryvar($var) [histinfo [lindex $histlist 0] $var]
1664	}
1665	} else {
1666	set hist $histlist
1667	set terms [histinfo $hist backterms]
1668	set expgui(backtermlbl) "($terms terms)"
1669	set expgui(backtypelbl) "Function type [histinfo $hist backtype]"
1670	foreach var {bref bdamp absref absdamp} {
1671	set entrycmd($var) "histinfo $hist $var"
1672	set entryvar($var) [eval $entrycmd($var)]
1673	}
1674	}
1675	# Top box
1676	if $expgui(haveBW) {
1677	catch {destroy $expgui(histFrame).pflag}
1678	}
1679	if {$expgui(globalmode) != 0} {
1680	$expgui(histFrame).top.txt config \
1681	-text "Selected Histograms: [CompressList $histlist]"
1682	grid $expgui(histFrame).top -column 1 -row 0 -sticky nsew
1683	set expgui(bkglbl) "Globally Edit Background"
1684	set expgui(abslbl) "Globally Edit Absorption"
1685	} else {
1686	grid forget $expgui(histFrame).top
1687	set expgui(bkglbl) "Edit Background"
1688	set expgui(abslbl) "Edit Abs./Refl."
1689	if {$expgui(haveBW) && [llength $expmap(phaselist)] > 1} {
1690	TitleFrame $expgui(histFrame).pflag \
1691	-borderwidth 4 -side left -relief groove \
1692	-text "Phase Flags"
1693	set expgui(pflag) [$expgui(histFrame).pflag getframe]
1694	grid $expgui(histFrame).pflag -column 1 -row 1 -sticky nsew
1695	grid rowconfigure $expgui(histFrame) 2 -minsize 35
1696	foreach p $expmap(phaselist) {
1697	pack [checkbutton $expgui(pflag).$p \
1698	-command "GetPhaseFlags $hist" \
1699	-variable expgui(pflag$p) -text $p] -side left
1700	if {[lsearch $expmap(phaselist_$hist) $p] == -1} {
1701	set expgui(pflag$p) 0
1702	} else {
1703	set expgui(pflag$p) 1
1704	}
1705	}
1706	}
1707	}
1708
1709	# diffractometer constants
1710	foreach var {lam1 lam2 kratio pola ipola ddamp zero \
1711	wref pref dcref daref ratref ttref zref } {
1712	set entrycmd($var) "histinfo [list $histlist] $var"
1713	set entryvar($var) [histinfo [lindex $histlist 0] $var]
1714	}
1715
1716	eval destroy [winfo children $expgui(diffBox)]
1717	if {$expgui(globalmode) == 0} {
1718	if {[string range $expmap(htype_$hist) 2 2] == "T"} {
1719	#------
1720	# TOF \|
1721	#------
1722	grid [ label $expgui(diffBox).lDCrc -text "Refine DIFC" ] \
1723	-column 1 -row 1
1724	grid [ checkbutton $expgui(diffBox).rfDCrc -variable entryvar(dcref) ] \
1725	-column 2 -row 1
1726	grid [ label $expgui(diffBox).lDCdifc -text DIFC ] \
1727	-column 3 -row 1 -sticky w
1728	grid [ entry $expgui(diffBox).eDCdifc -textvariable entryvar(lam1) \
1729	-width 15 ] -column 4 -row 1
1730	set entrybox(lam1) $expgui(diffBox).eDCdifc
1731	#
1732	grid [ label $expgui(diffBox).lDCra -text "Refine DIFA" ] \
1733	-column 1 -row 2
1734	grid [ checkbutton $expgui(diffBox).rfDCra -variable entryvar(daref) ] \
1735	-column 2 -row 2
1736	grid [ label $expgui(diffBox).lDCdifa -text DIFA ] \
1737	-column 3 -row 2
1738	grid [ entry $expgui(diffBox).eDCdifa -textvariable entryvar(lam2) \
1739	-width 15 ] -column 4 -row 2
1740	set entrybox(lam2) $expgui(diffBox).eDCdifa
1741	#
1742	grid [ label $expgui(diffBox).lDCzero -text "Zero"] \
1743	-column 3 -row 3
1744	grid [ entry $expgui(diffBox).eDCzero -textvariable entryvar(zero) \
1745	-width 15 ] -column 4 -row 3
1746	set entrybox(zero) $expgui(diffBox).eDCzero
1747	grid [ label $expgui(diffBox).lDCzref -text "Refine zero" ] \
1748	-column 1 -row 3 -sticky w
1749	grid [ checkbutton $expgui(diffBox).rfDCzref \
1750	-variable entryvar(zref) ] -column 2 -row 3
1751	} elseif {[string range $expmap(htype_$hist) 1 2] == "NC"} {
1752	#---------------
1753	# CW - neutron \|
1754	#---------------
1755	grid [ label $expgui(diffBox).lDC1 -text "Refine wave" ] \
1756	-column 1 -row 1
1757	grid [ checkbutton $expgui(diffBox).rfDC1 -variable entryvar(wref) ] \
1758	-column 2 -row 1
1759	grid [ label $expgui(diffBox).lDCdifc -text wave ] \
1760	-column 3 -row 1 -sticky w
1761	grid [ entry $expgui(diffBox).eDCdifc -textvariable entryvar(lam1) \
1762	-width 15 ] -column 4 -row 1
1763	set entrybox(lam1) $expgui(diffBox).eDCdifc
1764	#
1765	grid [ label $expgui(diffBox).lDCzref -text "Refine zero" ] \
1766	-column 1 -row 3 -sticky w
1767	grid [ checkbutton $expgui(diffBox).rfDCzref \
1768	-variable entryvar(zref) ] -column 2 -row 3
1769	grid [ label $expgui(diffBox).lDCzero -text "Zero"] \
1770	-column 3 -row 3
1771	grid [ entry $expgui(diffBox).eDCzero -textvariable entryvar(zero) \
1772	-width 15 ] -column 4 -row 3
1773	set entrybox(zero) $expgui(diffBox).eDCzero
1774	} elseif {[string range $expmap(htype_$hist) 1 2] == "XC" && \
1775	[histinfo $hist lam2] == 0.0} {
1776	#--------------------------
1777	# CW - x-ray 1 wavelength \|
1778	#--------------------------
1779	grid [ label $expgui(diffBox).lDC1 -text "Refine wave" ] \
1780	-column 1 -row 1
1781	grid [ checkbutton $expgui(diffBox).rfDC1 -variable entryvar(wref) ] \
1782	-column 2 -row 1
1783	grid [ label $expgui(diffBox).lDCdifc -text wave ] \
1784	-column 3 -row 1 -sticky w
1785	grid [ entry $expgui(diffBox).eDCdifc -textvariable entryvar(lam1) \
1786	-width 15 ] -column 4 -row 1
1787	set entrybox(lam1) $expgui(diffBox).eDCdifc
1788	#
1789	grid [ label $expgui(diffBox).lDCzref -text "Refine zero" ] \
1790	-column 1 -row 3 -sticky w
1791	grid [ checkbutton $expgui(diffBox).rfDCzref \
1792	-variable entryvar(zref) ] -column 2 -row 3
1793	grid [ label $expgui(diffBox).lDCzero -text "Zero"] \
1794	-column 3 -row 3
1795	grid [ entry $expgui(diffBox).eDCzero -textvariable entryvar(zero) \
1796	-width 15 ] -column 4 -row 3
1797	set entrybox(zero) $expgui(diffBox).eDCzero
1798	#
1799	grid [ label $expgui(diffBox).lDCpref -text "Refine POLA" ] \
1800	-column 1 -row 4 -sticky w
1801	grid [ checkbutton $expgui(diffBox).rfDCpref \
1802	-variable entryvar(pref) ] -column 2 -row 4
1803	grid [ label $expgui(diffBox).lDCpola -text POLA ] \
1804	-column 3 -row 4
1805	grid [ entry $expgui(diffBox).eDCpola \
1806	-textvariable entryvar(pola) -width 15 ] -column 4 -row 4
1807	set entrybox(pola) $expgui(diffBox).eDCpola
1808	grid [ label $expgui(diffBox).lDCipola -text "IPOLA" ] \
1809	-column 5 -row 4
1810	grid [ entry $expgui(diffBox).eDCipola -width 2 \
1811	-textvariable entryvar(ipola)] -column 6 -row 4
1812	set entrybox(ipola) $expgui(diffBox).eDCipola
1813	} elseif {[string range $expmap(htype_$hist) 1 2] == "XC"} {
1814	#---------------------------
1815	# CW - x-ray 2 wavelengths \|
1816	#---------------------------
1817	grid [ label $expgui(diffBox).lDCdifc -text wavelengths ] \
1818	-column 3 -row 1 -sticky w
1819	grid [ entry $expgui(diffBox).eDCdifc -textvariable entryvar(lam1) \
1820	-width 15 ] -column 4 -row 1
1821	set entrybox(lam1) $expgui(diffBox).eDCdifc
1822	grid [ entry $expgui(diffBox).eDCdifa -textvariable entryvar(lam2) \
1823	-width 15 ] -column 5 -row 1
1824	set entrybox(lam2) $expgui(diffBox).eDCdifa
1825	#
1826	grid [ label $expgui(diffBox).lDCrref -text "Refine ratio" ] \
1827	-column 1 -row 2 -sticky w
1828	grid [ checkbutton $expgui(diffBox).rfDCrref \
1829	-variable entryvar(ratref) ] -column 2 -row 2
1830	grid [ label $expgui(diffBox).lDCratio -text Ratio ] \
1831	-column 3 -row 2
1832	grid [ entry $expgui(diffBox).eDCkratio \
1833	-textvariable entryvar(kratio) \
1834	-width 15 ] -column 4 -row 2
1835	set entrybox(kratio) $expgui(diffBox).eDCkratio
1836	#
1837	grid [ label $expgui(diffBox).lDCzero -text "Zero"] \
1838	-column 3 -row 3
1839	grid [ entry $expgui(diffBox).eDCzero -textvariable entryvar(zero) \
1840	-width 15 ] -column 4 -row 3
1841	grid [ label $expgui(diffBox).lDCzref -text "Refine zero" ] \
1842	-column 1 -row 3 -sticky w
1843	set entrybox(zero) $expgui(diffBox).eDCzero
1844	grid [ checkbutton $expgui(diffBox).rfDCzref \
1845	-variable entryvar(zref) ] -column 2 -row 3
1846	grid [ label $expgui(diffBox).lDCpref -text "Refine POLA" ] \
1847	-column 1 -row 4 -sticky w
1848	grid [ checkbutton $expgui(diffBox).rfDCpref \
1849	-variable entryvar(pref) ] -column 2 -row 4
1850	grid [ label $expgui(diffBox).lDCpola -text POLA ] \
1851	-column 3 -row 4
1852	grid [ entry $expgui(diffBox).eDCpola \
1853	-textvariable entryvar(pola) -width 15 ] -column 4 -row 4
1854	set entrybox(pola) $expgui(diffBox).eDCpola
1855	grid [ label $expgui(diffBox).lDCipola -text "IPOLA" ] \
1856	-column 5 -row 4
1857	grid [ entry $expgui(diffBox).eDCipola -width 2 \
1858	-textvariable entryvar(ipola)] -column 6 -row 4
1859	set entrybox(ipola) $expgui(diffBox).eDCipola
1860	} elseif {[string range $expmap(htype_$hist) 1 2] == "XE"} {
1861	#-------------
1862	# ED - x-ray \|
1863	#-------------
1864	grid [ label $expgui(diffBox).lDC1 -text "Refine 2theta" ] \
1865	-column 1 -row 1
1866	grid [ checkbutton $expgui(diffBox).rfDC1 -variable entryvar(ttref) ] \
1867	-column 2 -row 1
1868	grid [ label $expgui(diffBox).lDCdifc -text 2Theta ] \
1869	-column 3 -row 1 -sticky w
1870	grid [ entry $expgui(diffBox).eDCdifc -textvariable entryvar(lam1) \
1871	-width 15 ] -column 4 -row 1
1872	set entrybox(lam1) $expgui(diffBox).eDCdifc
1873	#
1874	grid [ label $expgui(diffBox).lDCpref -text "Refine POLA" ] \
1875	-column 1 -row 4 -sticky w
1876	grid [ checkbutton $expgui(diffBox).rfDCpref \
1877	-variable entryvar(pref) ] -column 2 -row 4
1878	grid [ label $expgui(diffBox).lDCpola -text POLA ] \
1879	-column 3 -row 4
1880	grid [ entry $expgui(diffBox).eDCpola \
1881	-textvariable entryvar(pola) -width 15 ] -column 4 -row 4
1882	set entrybox(pola) $expgui(diffBox).eDCpola
1883	grid [ label $expgui(diffBox).lDCipola -text "IPOLA" ] \
1884	-column 5 -row 4
1885	grid [ entry $expgui(diffBox).eDCipola -width 2 \
1886	-textvariable entryvar(ipola)] -column 6 -row 4
1887	set entrybox(ipola) $expgui(diffBox).eDCipola
1888	}
1889	} elseif {$expgui(globalmode) == 1} {
1890	#-------------
1891	# Global TOF \|
1892	#-------------
1893	grid [ label $expgui(diffBox).lDCrc -text "Refine DIFC" ] \
1894	-column 1 -row 1
1895	grid [ checkbutton $expgui(diffBox).rfDCrc -variable entryvar(dcref) ] \
1896	-column 2 -row 1
1897	grid [button $expgui(diffBox).bDCdifc -text "Set DIFC Globally" \
1898	-command "editglobalparm histinfo difc {DIFC}"] -column 3 -row 1
1899	#
1900	grid [ label $expgui(diffBox).lDCra -text "Refine DIFA" ] \
1901	-column 1 -row 2
1902	grid [ checkbutton $expgui(diffBox).rfDCra -variable entryvar(daref) ] \
1903	-column 2 -row 2
1904	grid [ button $expgui(diffBox).bDCdifa -text "Set DIFA Globally" \
1905	-command "editglobalparm histinfo difa {DIFA}"] -column 3 -row 2
1906	#
1907	grid [ label $expgui(diffBox).lDCzref -text "Refine zero" ] \
1908	-column 1 -row 3 -sticky w
1909	grid [ checkbutton $expgui(diffBox).rfDCzref \
1910	-variable entryvar(zref) ] -column 2 -row 3
1911	grid [ button $expgui(diffBox).bDCzero -text "Set ZERO Globally" \
1912	-command "editglobalparm histinfo zero {Zero}"] -column 3 -row 3
1913	} elseif {$expgui(globalmode) == 2} {
1914	#--------------------
1915	# Global CW neutron \|
1916	#--------------------
1917	grid [ label $expgui(diffBox).lDC1 -text "Refine wave" ] \
1918	-column 1 -row 1
1919	grid [ checkbutton $expgui(diffBox).rfDC1 -variable entryvar(wref) ] \
1920	-column 2 -row 1
1921	grid [button $expgui(diffBox).bDCdifc -text "Set Wave Globally" \
1922	-command "editglobalparm histinfo lam1 Wavelength"] \
1923	-column 3 -row 1
1924	#
1925	grid [ label $expgui(diffBox).lDCzref -text "Refine zero" ] \
1926	-column 1 -row 3 -sticky w
1927	grid [ checkbutton $expgui(diffBox).rfDCzref \
1928	-variable entryvar(zref) ] -column 2 -row 3
1929	grid [button $expgui(diffBox).bDCzero -text "Set Zero Globally" \
1930	-command "editglobalparm histinfo zero Zero"] -column 3 -row 3
1931	} elseif {$expgui(globalmode) == 4} {
1932	#----------------------
1933	# Global CW mono xray \|
1934	#----------------------
1935	grid [ label $expgui(diffBox).lDC1 -text "Refine wave" ] \
1936	-column 1 -row 1
1937	grid [ checkbutton $expgui(diffBox).rfDC1 -variable entryvar(wref) ] \
1938	-column 2 -row 1
1939	grid [button $expgui(diffBox).bDCdifc -text "Set Wave Globally" \
1940	-command "editglobalparm histinfo lam1 Wavelength"] \
1941	-column 3 -row 1
1942	#
1943	grid [ label $expgui(diffBox).lDCzref -text "Refine zero" ] \
1944	-column 1 -row 3 -sticky w
1945	grid [ checkbutton $expgui(diffBox).rfDCzref \
1946	-variable entryvar(zref) ] -column 2 -row 3
1947	grid [button $expgui(diffBox).bDCzero -text "Set Zero Globally" \
1948	-command "editglobalparm histinfo zero Zero"] -column 3 -row 3
1949	#
1950	grid [ label $expgui(diffBox).lDCpref -text "Refine POLA" ] \
1951	-column 1 -row 4 -sticky w
1952	grid [ checkbutton $expgui(diffBox).rfDCpref \
1953	-variable entryvar(pref) ] -column 2 -row 4
1954	grid [button $expgui(diffBox).bDCpola -text "Set POLA Globally" \
1955	-command "editglobalparm histinfo pola POLA"] -column 3 -row 4
1956	grid [button $expgui(diffBox).bDCipola -text "Set IPOLA Globally" \
1957	-command "editglobalparm histinfo ipola IPOLA"] -column 4 -row 4
1958	} elseif {$expgui(globalmode) == 3} {
1959	#------------------------
1960	# Global alpha 1,2 xray \|
1961	#------------------------
1962	grid [button $expgui(diffBox).bDCl1 -text "Set Wave1 Globally" \
1963	-command "editglobalparm histinfo lam1 {Wavelength 1}"] \
1964	-column 3 -row 1
1965	grid [button $expgui(diffBox).bDCl2 -text "Set Wave2 Globally" \
1966	-command "editglobalparm histinfo lam2 {Wavelength 2}"] \
1967	-column 4 -row 1
1968	#
1969	grid [ label $expgui(diffBox).lDCratref -text "Refine Ratio" ] \
1970	-column 1 -row 2 -sticky w
1971	grid [ checkbutton $expgui(diffBox).rfDCratref \
1972	-variable entryvar(ratref) ] -column 2 -row 2
1973	grid [button $expgui(diffBox).bDCrrat -text "Set Ratio Globally" \
1974	-command "editglobalparm histinfo ratio {Wavelength Ratio}"] \
1975	-column 3 -row 2
1976	#
1977	grid [ label $expgui(diffBox).lDCzref -text "Refine zero" ] \
1978	-column 1 -row 3 -sticky w
1979	grid [ checkbutton $expgui(diffBox).rfDCzref \
1980	-variable entryvar(zref) ] -column 2 -row 3
1981	grid [button $expgui(diffBox).bDCzero -text "Set Zero Globally" \
1982	-command "editglobalparm histinfo zero Zero"] -column 3 -row 3
1983	#
1984	grid [ label $expgui(diffBox).lDCpref -text "Refine POLA" ] \
1985	-column 1 -row 4 -sticky w
1986	grid [ checkbutton $expgui(diffBox).rfDCpref \
1987	-variable entryvar(pref) ] -column 2 -row 4
1988	grid [button $expgui(diffBox).bDCpola -text "Set POLA Globally" \
1989	-command "editglobalparm histinfo pola POLA"] -column 3 -row 4
1990	grid [button $expgui(diffBox).bDCipola -text "Set IPOLA Globally" \
1991	-command "editglobalparm histinfo ipola IPOLA"] -column 4 -row 4
1992	} elseif {$expgui(globalmode) == 5} {
1993	#-----------------
1994	# Global ED xray \|
1995	#-----------------
1996	grid [ label $expgui(diffBox).lDC1 -text "Refine 2theta" ] \
1997	-column 1 -row 1
1998	grid [ checkbutton $expgui(diffBox).rfDC1 -variable entryvar(ttref) ] \
1999	-column 2 -row 1
2000	grid [button $expgui(diffBox).bDCdifc -text "Set 2Theta Globally" \
2001	-command "editglobalparm histinfo ratio {Fixed 2Theta}"] \
2002	-column 3 -row 1
2003	#
2004	grid [ label $expgui(diffBox).lDCpref -text "Refine POLA" ] \
2005	-column 1 -row 4 -sticky w
2006	grid [ checkbutton $expgui(diffBox).rfDCpref \
2007	-variable entryvar(pref) ] -column 2 -row 4
2008	grid [button $expgui(diffBox).bDCpola -text "Set POLA Globally" \
2009	-command "editglobalparm histinfo pola POLA"] -column 3 -row 4
2010	grid [button $expgui(diffBox).bDCipola -text "Set IPOLA Globally" \
2011	-command "editglobalparm histinfo ipola IPOLA"] -column 4 -row 4
2012	}
2013	if {$expgui(globalmode) == 0} {
2014	grid [frame $expgui(diffBox).d] -column 5 -row 1 -rowspan 3 \
2015	-columnspan 2 -sticky e
2016	} else {
2017	grid [frame $expgui(diffBox).d] -column 4 -row 2 -rowspan 2 \
2018	-columnspan 2 -sticky e
2019	}
2020	grid [label $expgui(diffBox).d.lDamp -text "Damping "] \
2021	-column 1 -row 1
2022	tk_optionMenu $expgui(diffBox).d.om entryvar(ddamp) 0 1 2 3 4 5 6 7 8 9
2023	grid $expgui(diffBox).d.om -column 2 -row 1
2024	grid columnconfigure $expgui(diffBox) 9 -weight 1
2025	grid columnconfigure $expgui(diffBox) 0 -weight 1
2026	update idletasks
2027	# enable traces on entryvar now
2028	set entrycmd(trace) 1
2029	}
2030
2031	# this gets the phase flags as set in the expgui(pflag*) elements
2032	# (linked to phase flag checkbuttons) and the sets the "HST xx NPHAS" flags
2033	# accordingly using SetPhaseFlag
2034	proc GetPhaseFlags {hist} {
2035	global expmap expgui
2036	set plist {}
2037	foreach p $expmap(phaselist) {
2038	if {$expgui(pflag$p)} {lappend plist $p}
2039	}
2040	SetPhaseFlag $hist $plist
2041	incr expgui(changed)
2042	# set the powpref warning (1 = suggested)
2043	set expgui(needpowpref) 2
2044	set msg "Phase flags"
2045	if {[string first $msg $expgui(needpowpref_why)] == -1} {
2046	append expgui(needpowpref_why) "\t$msg were changed\n"
2047	}
2048	mapexp
2049	}
2050
2051	#-----------------------------------------------------------------------
2052	# populate the Scaling page
2053	#-----------------------------------------------------------------------
2054	proc DisplayFrac {} {
2055	global expgui entrycmd entryvar entrybox expmap
2056
2057	# trap if more than one histogram is selected unless global mode
2058	if {$expgui(globalmode) == 0 && [llength $expgui(curhist)] > 1} {
2059	set expgui(curhist) [lindex $expgui(curhist) 0]
2060	}
2061
2062	# display the selected histograms
2063	$expgui(fracFrame).hs.lbox selection clear 0 end
2064	foreach h $expgui(curhist) {
2065	$expgui(fracFrame).hs.lbox selection set $h
2066	}
2067
2068	# disable traces on entryvar
2069	set entrycmd(trace) 0
2070
2071	# get histogram list
2072	set histlist {}
2073	foreach item $expgui(curhist) {
2074	lappend histlist [lindex $expmap(powderlist) $item]
2075	}
2076
2077	# must have at least one histogram selected here
2078	if {[llength $histlist] == 0} {
2079	foreach var {scale sref sdamp} {
2080	set entrycmd($var) ""
2081	set entryvar($var) ""
2082	}
2083	set parm [grid info $expgui(scaleBox).but1]
2084	if {$parm != ""} {
2085	grid forget $expgui(scaleBox).but1
2086	eval grid $expgui(scaleBox).ent1 $parm
2087	}
2088	# destroy the contents of the frame
2089	set phaseFractf1 $expgui(FracBox).f
2090	eval destroy [winfo children $phaseFractf1]
2091	# reenable traces on entryvar
2092	set entrycmd(trace) 1
2093	return
2094	}
2095
2096	#--------------
2097	# Scale factor
2098	#--------------
2099	if {$expgui(globalmode) != 0} {
2100	foreach var {scale sref sdamp} {
2101	set entrycmd($var) "histinfo [list $histlist] $var"
2102	set entryvar($var) [histinfo [lindex $histlist 0] $var]
2103	}
2104	# reset scale to black
2105	catch {$entrybox(scale) config -fg black}
2106	set parm [grid info $expgui(scaleBox).ent1]
2107	if {$parm != ""} {
2108	grid forget $expgui(scaleBox).ent1
2109	eval grid $expgui(scaleBox).but1 $parm
2110	}
2111	} else {
2112	set hist $histlist
2113	foreach var {scale sref sdamp} {
2114	set entrycmd($var) "histinfo $hist $var"
2115	set entryvar($var) [eval $entrycmd($var)]
2116	}
2117	# reset scale to black
2118	catch {$entrybox(scale) config -fg black}
2119	set parm [grid info $expgui(scaleBox).but1]
2120	if {$parm != ""} {
2121	grid forget $expgui(scaleBox).but1
2122	eval grid $expgui(scaleBox).ent1 $parm
2123	}
2124	}
2125
2126	#----------------
2127	# Phase Fractions
2128	#----------------
2129	set phaseFractf1 $expgui(FracBox).f
2130	# destroy the contents of the frame
2131	eval destroy [winfo children $phaseFractf1]
2132	if {$expgui(globalmode) != 0} {
2133	set txt "Phase Fractions for Histograms: [CompressList $histlist]"
2134	} else {
2135	set txt "Phase Fractions"
2136	}
2137	if $expgui(haveBW) {
2138	$expgui(fracFrame).f1.phaseFrac configure -text $txt
2139	} else {
2140	grid [label $phaseFractf1.txt -anchor center -text $txt] \
2141	-column 0 -row 0 -sticky news
2142	}
2143	# Create the frame inside the canvas, One frame for each Phase.
2144	foreach i {1 2 3 4 5 6 7 8 9} {set phasehistlist($i) ""}
2145	foreach hist $histlist {
2146	foreach i $expmap(phaselist_$hist) {
2147	lappend phasehistlist($i) $hist
2148	}
2149	}
2150	foreach i {1 2 3 4 5 6 7 8 9} {
2151	if {[llength $phasehistlist($i)] == 0} continue
2152	set framePF [frame $phaseFractf1.pF$i -relief groove -bd 4]
2153	grid $framePF -column 0 -row $i -sticky ew
2154	# Label Heading for each phase.
2155	if {$expgui(globalmode) != 0} {
2156	grid [label $framePF.l1 \
2157	-text "Phase $i Hist: [CompressList $phasehistlist($i)]"] \
2158	-column 0 -row 0 -sticky nws
2159	grid [button $framePF.but1 -text "Set Globally" \
2160	-command "editglobalparm hapinfo frac \"Phase $i Fraction\" \
2161	[list $phasehistlist($i)] $i" \
2162	] -column 1 -row 0
2163	} else {
2164	grid [label $framePF.l1 -text "Phase $i"] \
2165	-column 0 -row 0 -sticky nws
2166	grid [entry $framePF.ent -textvariable entryvar(frac$i) -width 15]\
2167	-column 1 -row 0
2168	set entrybox(frac$i) $framePF.ent
2169	}
2170	set entrycmd(frac$i) "hapinfo $hist $i frac"
2171	set entryvar(frac$i) [hapinfo $hist $i frac]
2172	grid [label $framePF.l2 -text " Refine"] \
2173	-column 2 -row 0 -sticky nws
2174	grid [checkbutton $framePF.cb -variable entryvar(frref$i)] \
2175	-column 3 -row 0 -sticky nws
2176	set entrycmd(frref$i) "hapinfo $hist $i frref"
2177	set entryvar(frref$i) [hapinfo $hist $i frref]
2178	grid [label $framePF.l3 -text " Damping"] \
2179	-column 4 -row 0 -sticky nws
2180	tk_optionMenu $framePF.tkOptDamp entryvar(frdamp$i) \
2181	0 1 2 3 4 5 6 7 8 9
2182	set entrycmd(frdamp$i) "hapinfo $hist $i frdamp"
2183	set entryvar(frdamp$i) [hapinfo $hist $i frdamp]
2184	grid $framePF.tkOptDamp -row 0 -sticky nsw -column 5
2185	}
2186	# resize the scroll window to match the actual
2187	update idletasks
2188	$expgui(FracBox) config -scrollregion [grid bbox $expgui(FracBox).f]
2189	$expgui(FracBox) config -width [lindex [grid bbox $expgui(FracBox).f] 2]
2190	update idletasks
2191	# enable traces on entryvar now
2192	set entrycmd(trace) 1
2193	}
2194
2195	#-----------------------------------------------------------------------
2196	# display the profile page
2197	#-----------------------------------------------------------------------
2198	proc DisplayProfile {} {
2199	global expgui entrycmd entryvar entrybox expmap
2200
2201	# trap if more than one histogram is selected unless global mode
2202	if {$expgui(globalmode) == 0 && [llength $expgui(curhist)] > 1} {
2203	set expgui(curhist) [lindex $expgui(curhist) 0]
2204	}
2205	# display the selected histograms
2206	$expgui(profFrame).hs.lbox selection clear 0 end
2207	foreach h $expgui(curhist) {
2208	$expgui(profFrame).hs.lbox selection set $h
2209	}
2210
2211	# destroy the contents of the frame
2212	eval destroy [winfo children $expgui(ProfileBox).f]
2213	# since the next steps can take a while, do a screen update
2214	update idletasks
2215
2216	if {$expgui(globalmode) == 0} {
2217	# must have at least one histogram selected here
2218	if {[llength $expgui(curhist)] == 0} return
2219	# disable traces on entryvar for right now
2220	set entrycmd(trace) 0
2221	set hist [lindex $expmap(powderlist) $expgui(curhist)]
2222	# no defined histograms?
2223	if {$hist == ""} return
2224	# Create one frame for each Phase.
2225	set ind -1
2226	set htype [string range $expmap(htype_$hist) 2 2]
2227	foreach i $expmap(phaselist_$hist) {
2228	incr ind
2229	# Label Heading for each phase.
2230	set ptype [string trim [hapinfo $hist $i proftype]]
2231	if {$expgui(haveBW)} {
2232	grid [TitleFrame $expgui(ProfileBox).f.$i \
2233	-text "Hist $hist -- Phase $i (type $ptype)" \
2234	-relief groove -bd 2] \
2235	-column 0 -row $ind -sticky ew
2236	set ProfileFrame [$expgui(ProfileBox).f.$i getframe]
2237	grid [frame $ProfileFrame.1] \
2238	-column 0 -row 0 -columnspan 10
2239	pack [label $ProfileFrame.1.l \
2240	-text Damping]\
2241	-side left
2242	} else {
2243	grid [frame $expgui(ProfileBox).f.$i -relief groove -bd 4] \
2244	-column 0 -row $ind -sticky ew
2245	set ProfileFrame $expgui(ProfileBox).f.$i
2246	grid [frame $ProfileFrame.1] \
2247	-column 0 -row 0 -columnspan 10 -sticky ew
2248	pack [label $ProfileFrame.1.l \
2249	-text "Phase $i (type $ptype) Damping"]\
2250	-side left
2251	}
2252	tk_optionMenu $ProfileFrame.1.tkOptDamp entryvar(pdamp_$i) \
2253	0 1 2 3 4 5 6 7 8 9
2254	set entrycmd(pdamp_$i) "hapinfo $hist $i pdamp"
2255	set entryvar(pdamp_$i) [hapinfo $hist $i pdamp]
2256	pack $ProfileFrame.1.tkOptDamp -side left
2257	pack [label $ProfileFrame.1.l1 \
2258	-text " Peak cutoff"]\
2259	-side left
2260	pack [entry $ProfileFrame.1.e1 \
2261	-width 10 -textvariable entryvar(pcut_$i)]\
2262	-side left
2263	set entrybox(pcut_$i) $ProfileFrame.1.e1
2264	set entrycmd(pcut_$i) "hapinfo $hist $i pcut"
2265	set entryvar(pcut_$i) [hapinfo $hist $i pcut]
2266
2267	pack [button $ProfileFrame.1.b1 \
2268	-text "Change Type" \
2269	-command "ChangeProfileType $hist $i"]\
2270	-side left
2271
2272	set col -1
2273	set row 1
2274	set nterms [hapinfo $hist $i profterms]
2275	set lbls "dummy [GetProfileTerms $i $hist $ptype]"
2276	for { set num 1 } { $num <= $nterms } { incr num } {
2277	set term {}
2278	catch {set term [lindex $lbls $num]}
2279	if {$term == ""} {set term $num}
2280	incr col
2281	grid [label $ProfileFrame.l${num}_${i} -text "$term"] \
2282	-row $row -column $col
2283	incr col
2284	grid [checkbutton $ProfileFrame.ref${num}_${i} \
2285	-variable entryvar(pref${num}_$i)] -row $row -column $col
2286	set entrycmd(pref${num}_$i) "hapinfo $hist $i pref$num"
2287	set entryvar(pref${num}_$i) [hapinfo $hist $i pref$num]
2288	incr col
2289	grid [entry $ProfileFrame.ent${num}_${i} \
2290	-textvariable entryvar(pterm${num}_$i)\
2291	-width 12] -row $row -column $col
2292	set entrybox(pterm${num}_$i) $ProfileFrame.ent${num}_${i}
2293	set entrycmd(pterm${num}_$i) "hapinfo $hist $i pterm$num"
2294	set entryvar(pterm${num}_$i) [hapinfo $hist $i pterm$num]
2295	if {$col > 6} {set col -1; incr row}
2296	}
2297	}
2298	grid columnconfigure $expgui(ProfileBox).f 0 -weight 1
2299	} else {
2300	# get histogram list
2301	set histlist {}
2302	foreach item $expgui(curhist) {
2303	lappend histlist [lindex $expmap(powderlist) $item]
2304	}
2305	# must have at least one histogram selected here
2306	if {[llength $histlist] == 0} return
2307	# disable traces on entryvar for right now
2308	set entrycmd(trace) 0
2309	# loop through histograms & phases, set up an array by phase & profile type
2310	catch {unset prtyparray histarray phasearray}
2311	foreach hist $histlist {
2312	foreach phase $expmap(phaselist_$hist) {
2313	set prtyp [string trim [hapinfo $hist $phase proftype]]
2314	set key ${prtyp}_$phase
2315	lappend prtyparray($key) $hist
2316	lappend histarray($key) $hist
2317	lappend phasearray($key) $phase
2318	}
2319	}
2320
2321	set ptype ""
2322	set i -1
2323	# loop over all combined phases and profile types, sorted 1st by profile number
2324	foreach key [lsort [array names prtyparray]] {
2325	# split key
2326	scan $key %d_%d prftyp p
2327
2328	if {$ptype != $prftyp \|\| !$expgui(globalphasemode)} {
2329	set ptype $prftyp
2330	set curhistlist $histarray($key)
2331	set curphaslist $phasearray($key)
2332
2333	set hist1 [lindex $curhistlist 0]
2334	set phase1 [lindex $curphaslist 0]
2335	set nterms [hapinfo $hist1 $phase1 profterms]
2336	set htype [string range $expmap(htype_$hist1) 2 2]
2337	set lbls "dummy [GetProfileTerms $phase1 $hist1 $ptype]"
2338	# Create a frame for this type
2339	incr i
2340	set boxtitle "Phase $p, hist [CompressList $histarray($key)]"
2341	if {$expgui(haveBW)} {
2342	grid [TitleFrame $expgui(ProfileBox).f.$i \
2343	-text "(type $ptype)" \
2344	-relief groove -bd 2] \
2345	-column 0 -row $i -sticky ew
2346	set ProfileFrame [$expgui(ProfileBox).f.$i getframe]
2347	grid [frame $ProfileFrame.0] \
2348	-column 0 -row 0 -columnspan 20 -sticky ew
2349	} else {
2350	grid [frame $expgui(ProfileBox).f.$i \
2351	-relief groove -bd 4] \
2352	-column 0 -row $i -sticky ew
2353	set ProfileFrame $expgui(ProfileBox).f.$i
2354	grid [frame $ProfileFrame.0] \
2355	-column 0 -row 0 -columnspan 20 -sticky ew
2356	grid [label $ProfileFrame.0.0 \
2357	-text "Profile Type $ptype "] -row 0 -column 0
2358	}
2359	grid [label $ProfileFrame.0.1 \
2360	-anchor w] -row 0 -column 1
2361	grid [frame $ProfileFrame.1] \
2362	-column 0 -row 1 -columnspan 20 -sticky ew
2363	grid [label $ProfileFrame.1.2 \
2364	-text "Damping"] -row 0 -column 2
2365	tk_optionMenu $ProfileFrame.1.tkOptDamp \
2366	entryvar(pdamp_$i) 0 1 2 3 4 5 6 7 8 9
2367	grid $ProfileFrame.1.tkOptDamp -row 0 -column 3
2368	grid [button $ProfileFrame.1.edit \
2369	-text "Global Edit"] -row 0 -column 4 -sticky w
2370	set entryvar(pdamp_$i) [hapinfo $hist $phase pdamp]
2371	grid [button $ProfileFrame.1.b1 -text "Change Type"] \
2372	-row 0 -column 5 -sticky w
2373	set col -1
2374	set row 2
2375	for { set num 1 } { $num <= $nterms } { incr num } {
2376	set term {}
2377	catch {set term [lindex $lbls $num]}
2378	if {$term == ""} {set term $num}
2379	incr col
2380	grid [label $ProfileFrame.l${num}_${i} \
2381	-text "$term"] -row $row -column $col
2382	incr col
2383	grid [checkbutton $ProfileFrame.ref${num}_${i} \
2384	-variable entryvar(pref${num}_$i)] \
2385	-row $row -column $col
2386	set entryvar(pref${num}_$i) [hapinfo $hist $phase pref$num]
2387	if {$col > 10} {set col -1; incr row}
2388	}
2389	grid columnconfigure $expgui(ProfileBox).f 0 -weight 1
2390	} else {
2391	# add to the current entry
2392	eval lappend curhistlist $histarray($key)
2393	eval lappend curphaslist $phasearray($key)
2394	append boxtitle "\nPhase $p, hist [CompressList $histarray($key)]"
2395	}
2396	$ProfileFrame.0.1 config -text $boxtitle
2397	$ProfileFrame.1.edit config -command "\
2398	EditProfile \"\n$boxtitle\" \
2399	[list $curhistlist] \
2400	[list $curphaslist]"
2401	$ProfileFrame.1.b1 config -command "ChangeProfileType \
2402	[list $curhistlist] [list $curphaslist]"
2403	set entrycmd(pdamp_$i) "hapinfo \
2404	[list $curhistlist] \
2405	[list $curphaslist] pdamp"
2406	for { set num 1 } { $num <= $nterms } { incr num } {
2407	set entrycmd(pref${num}_$i) "hapinfo \
2408	[list $curhistlist] \
2409	[list $curphaslist] pref$num"
2410	}
2411	}
2412	}
2413
2414	# resize the scroll window to match the actual
2415	update idletasks
2416	$expgui(ProfileBox) config -scrollregion [grid bbox $expgui(ProfileBox).f]
2417	$expgui(ProfileBox) config -width [lindex [grid bbox $expgui(ProfileBox).f] 2]
2418	update idletasks
2419	ResizeNotebook
2420	# enable traces on entryvar now
2421	set entrycmd(trace) 1
2422	}
2423
2424	# process the bit settings in the print options
2425	# bitnum -- the number of the bit to be tested/set starting at 0 for the LSBit
2426	proc printsetting {bitnum "action get" "value {}"} {
2427	global entryvar expgui
2428	if {$action == "get"} {
2429	return [expr ([expinfo print] & int(pow(2,$bitnum))) != 0]
2430	} elseif $value {
2431	set newval [expr ([expinfo print] \| int(pow(2,$bitnum)))]
2432	} else {
2433	set newval [expr ([expinfo print] & ~int(pow(2,$bitnum)))]
2434	}
2435	expinfo print set $newval
2436	set expgui(printopt) "Print Options ([expinfo print])"
2437	}
2438
2439	# need to respond to mouse presses -- control variable associated with extract Fobs
2440	# and set the LeBail extraction flags
2441	proc SetupExtractHist {} {
2442	global expgui entrycmd entryvar expmap
2443
2444	# display the selected histograms
2445	$expgui(lsFrame).hs.lbox selection clear 0 end
2446	foreach h $expgui(curhist) {
2447	$expgui(lsFrame).hs.lbox selection set $h
2448	}
2449
2450	# get histogram list
2451	set histlist {}
2452	foreach item $expgui(curhist) {
2453	set hist [lindex $expmap(powderlist) $item]
2454	if {$hist != ""} {lappend histlist $hist}
2455	}
2456	set entrycmd(fobsextract) "histinfo [list $histlist] foextract"
2457	if {[llength $histlist] == 0 \|\| [string trim $histlist] == ""} {
2458	set entrycmd(LBdamp) ""
2459	foreach phase {1 2 3 4 5 6 7 8 9} {
2460	$expgui(FobsExtractFrame).l$phase config -fg grey
2461	set expgui(Fextract$phase) {}
2462	foreach item $expgui(ExtractSettingsRadiobuttons) {
2463	${item}$phase config -state disabled -bd 1
2464	}
2465	}
2466	} elseif {[llength $histlist] == 1} {
2467	# disable traces on entryvar
2468	set entrycmd(trace) 0
2469	set entryvar(fobsextract) [histinfo $histlist foextract]
2470	set entrycmd(LBdamp) "histinfo $histlist LBdamp"
2471	set entryvar(LBdamp) [histinfo $histlist LBdamp]
2472	foreach phase {1 2 3 4 5 6 7 8 9} {
2473	# is the phase present?
2474	if {[lsearch -exact $expmap(phaselist_$histlist) $phase] == -1} {
2475	$expgui(FobsExtractFrame).l$phase config -fg grey
2476	set expgui(Fextract$phase) {}
2477	foreach item $expgui(ExtractSettingsRadiobuttons) {
2478	${item}$phase config -state disabled -bd 1
2479	}
2480	} else {
2481	$expgui(FobsExtractFrame).l$phase config -fg black
2482	foreach item $expgui(ExtractSettingsRadiobuttons) {
2483	${item}$phase config -state normal -bd 2
2484	}
2485	set expgui(Fextract$phase) [hapinfo $histlist $phase extmeth]
2486	}
2487	}
2488	} elseif {[llength $histlist] > 1} {
2489	# disable traces on entryvar
2490	set entrycmd(LBdamp) "histinfo [list $histlist] LBdamp"
2491	set entryvar(LBdamp) [histinfo [lindex $histlist 0] LBdamp]
2492	set entrycmd(trace) 0
2493	# multiple histograms need phases in any histogram
2494	foreach phase {1 2 3 4 5 6 7 8 9} {
2495	set gotphase($phase) 0
2496	}
2497	foreach hist $histlist {
2498	foreach phase $expmap(phaselist_$hist) {
2499	set gotphase($phase) 1
2500	}
2501	}
2502	foreach phase {1 2 3 4 5 6 7 8 9} {
2503	set expgui(Fextract$phase) {}
2504	if $gotphase($phase) {
2505	$expgui(FobsExtractFrame).l$phase config -fg black
2506	foreach item $expgui(ExtractSettingsRadiobuttons) {
2507	${item}$phase config -state normal -bd 2
2508	}
2509	} else {
2510	$expgui(FobsExtractFrame).l$phase config -fg grey
2511	foreach item $expgui(ExtractSettingsRadiobuttons) {
2512	${item}$phase config -state disabled -bd 1
2513	}
2514	}
2515	}
2516	}
2517	# reenable traces
2518	set entrycmd(trace) 1
2519	}
2520	# respond to a change in the fobs extraction method for a phase
2521	# force the main extraction flag on, if fobs extraction is selected for any phase
2522	proc HistExtractSet {phase} {
2523	global expgui entryvar expmap
2524	foreach item $expgui(curhist) {
2525	lappend histlist [lindex $expmap(powderlist) $item]
2526	}
2527	hapinfo $histlist $phase extmeth set $expgui(Fextract$phase)
2528	incr expgui(changed)
2529	if {$expgui(Fextract$phase) != 0} {set entryvar(fobsextract) 1}
2530	}
2531	#---------------------------- Global Edit Functions ------------------------
2532	proc editbackground {} {
2533	global expgui expmap entrycmd
2534	set histlist {}
2535	foreach n $expgui(curhist) {
2536	lappend histlist [lindex $expmap(powderlist) $n]
2537	}
2538	if {[llength $histlist] == 0} return
2539
2540	set w .back
2541	catch {destroy $w}
2542	toplevel $w -bg beige
2543	if {$expgui(globalmode) != 0} {
2544	wm title $w "Global Edit Background"
2545	} else {
2546	wm title $w "Edit Background"
2547	}
2548
2549	pack [frame $w.0 -bd 6 -relief groove -bg beige \
2550	] -side top -expand yes -fill both
2551	if {[llength $histlist] > 1} {
2552	grid [label $w.0.a \
2553	-text "Setting background terms for histograms [CompressList $histlist]" \
2554	-bg beige] -row 0 -column 0 -columnspan 10
2555	} else {
2556	grid [label $w.0.a \
2557	-text "Setting background terms for histogram $histlist" \
2558	-bg beige] -row 0 -column 0 -columnspan 4
2559	grid [button $w.0.bkg -text "Fit Background\nGraphically" \
2560	-command "QuitEditBackground $w; bkgedit $histlist"] \
2561	-row 0 -column 4 -rowspan 2
2562	grid columnconfig $w.0 0 -weight 1
2563	grid columnconfig $w.0 4 -weight 1
2564	}
2565	set hist [lindex $histlist 0]
2566	grid [label $w.0.b -text "Function type" -bg beige] -row 1 -column 0 -sticky e
2567
2568	# disable traces on expgui(backtype) & expgui(backterms) now
2569	set entrycmd(trace) 0
2570
2571	# number of terms
2572	set expgui(backtype) [histinfo $hist backtype]
2573	set expgui(orig_backtype) $expgui(backtype)
2574	set expgui(prev_backtype) $expgui(backtype)
2575	set typemenu [tk_optionMenu $w.0.type expgui(backtype) null]
2576	$typemenu delete 0 end
2577	foreach item {
2578	"1 - Shifted Chebyschev"
2579	"2 - Cosine Fourier series"
2580	"3 - Radial distribution peaks"
2581	"4 - Power series in Q**2n/n!"
2582	"5 - Power series in n!/Q**2n"
2583	"6 - Power series in Q2n/n! and n!/Q2n"
2584	"7 - Linear interpolation function"
2585	"8 - Reciprocal interpolation function"
2586	} {
2587	set val [lindex $item 0]
2588	$typemenu insert end radiobutton -variable expgui(backtype) \
2589	-label $item -value $val
2590	}
2591
2592	grid $w.0.type -row 1 -column 1
2593	grid [label $w.0.c -text " Number of terms" -bg beige] -row 1 -column 2
2594
2595	# function type
2596	set expgui(backterms) [histinfo $hist backterms]
2597	set expgui(orig_backterms) $expgui(backterms)
2598	set list {}; for {set i 1} {$i <= 36} {incr i} {lappend list $i}
2599	eval tk_optionMenu $w.0.terms expgui(backterms) $list
2600	grid $w.0.terms -row 1 -column 3
2601	# enable traces on expgui(backtype) & expgui(backterms) now
2602	set entrycmd(trace) 1
2603
2604	#set background terms
2605	for {set num 1 } { $num <= 36 } { incr num } {
2606	set var "bterm$num"
2607	set expgui($var) {}
2608	set expgui(orig_$var) {}
2609	}
2610	if {[llength $histlist] == 1} {
2611	for {set num 1 } { $num <= $expgui(backterms) } { incr num } {
2612	set var "bterm$num"
2613	set expgui($var) [histinfo $histlist $var]
2614	set expgui(orig_$var) $expgui($var)
2615	}
2616	}
2617
2618	pack [frame $w.1 -bd 6 -relief groove -bg beige] -side top \
2619	-expand yes -fill both
2620	ShowBackTerms $w.1
2621
2622	set expgui(temp) {}
2623	pack [frame $w.b -bg beige] -fill x -expand yes -side top
2624	grid [button $w.b.2 -text Set -command "destroy $w"] -row 0 -column 1
2625	grid [button $w.b.3 -text Quit \
2626	-command "QuitEditBackground $w"] -row 0 -column 2
2627	grid [button $w.b.help -text Help -bg yellow \
2628	-command "MakeWWWHelp expgui3.html EditBackground"] \
2629	-row 0 -column 4
2630	grid columnconfig $w.b 0 -weight 1
2631	grid columnconfig $w.b 3 -weight 1
2632	bind $w <Key-F1> "MakeWWWHelp expgui3.html EditBackground"
2633	bind $w <Return> "destroy $w"
2634
2635	# force the window to stay on top
2636	putontop $w
2637
2638	focus $w.b.2
2639	tkwait window $w
2640	afterputontop
2641
2642	if {$expgui(temp) != ""} return
2643
2644	if {$expgui(orig_backtype) != $expgui(backtype)} {
2645	histinfo $histlist backtype set $expgui(backtype)
2646	incr expgui(changed)
2647	}
2648	if {$expgui(orig_backterms) != $expgui(backterms)} {
2649	histinfo $histlist backterms set $expgui(backterms)
2650	incr expgui(changed)
2651	}
2652	for {set num 1 } { $num <= $expgui(backterms) } { incr num } {
2653	set var "bterm$num"
2654	if {$expgui(orig_$var) != $expgui($var)} {
2655	histinfo $histlist $var set $expgui($var)
2656	incr expgui(changed)
2657	}
2658	}
2659
2660	if {$expgui(globalmode) == 0} {
2661	set expgui(backtypelbl) "Function type [histinfo $hist backtype]"
2662	set expgui(backtermlbl) "([histinfo $hist backterms] terms)"
2663	}
2664	}
2665
2666	trace variable expgui(backterms) w ChangeBackTerms
2667	proc ChangeBackTerms {a b c} {
2668	global entrycmd expgui
2669	if !$entrycmd(trace) return
2670	ShowBackTerms .back.1
2671	}
2672
2673	trace variable expgui(backtype) w ChangeBackType
2674	# reset the terms to 1, 0, 0... when the number of terms increase
2675	proc ChangeBackType {a b c} {
2676	global entrycmd expgui
2677	if !$entrycmd(trace) return
2678	if {$expgui(prev_backtype) == $expgui(backtype)} return
2679	set expgui(prev_backtype) $expgui(backtype)
2680	for {set num 1 } { $num <= $expgui(backterms) } { incr num } {
2681	set var "bterm$num"
2682	if {$num == 1} {
2683	set expgui($var) 1.0
2684	} else {
2685	set expgui($var) 0.0
2686	}
2687	}
2688	}
2689
2690	proc ShowBackTerms {w } {
2691	global expgui expmap
2692	# destroy the contents of the frame
2693	eval destroy [winfo children $w]
2694	set histlist {}
2695	foreach n $expgui(curhist) {
2696	lappend histlist [lindex $expmap(powderlist) $n]
2697	}
2698	set widgetsPerRow 4
2699	for {set rows 2; set num 1 } { $num <= $expgui(backterms) } { incr rows } {
2700	for {set cols 0} { (2*$widgetsPerRow > $cols) && ($num <= $expgui(backterms)) } { incr num } {
2701	set var "bterm$num"
2702	grid [label $w.l$num -text $num -bg beige] \
2703	-row $rows -column $cols -sticky nes
2704	incr cols
2705	grid [entry $w.e$num -width 15 -textvariable expgui($var) \
2706	] -row $rows -column $cols -sticky news
2707	incr cols
2708	}
2709	}
2710	}
2711
2712	proc QuitEditBackground {w} {
2713	global expgui
2714	# lets find out if anything changed
2715	set changed 0
2716	if {$expgui(orig_backtype) != $expgui(backtype)} {
2717	set changed 1
2718	}
2719	if {$expgui(orig_backterms) != $expgui(backterms)} {
2720	set changed 1
2721	}
2722	for {set num 1 } { $num <= $expgui(backterms) } { incr num } {
2723	set var "bterm$num"
2724	if {$expgui(orig_$var) != $expgui($var)} {
2725	set changed 1
2726	break
2727	}
2728	}
2729	if $changed {
2730	set decision [tk_dialog .changes "Abandon Changes" \
2731	"You have made changes to the background. Ok to abandon changes?" \
2732	warning 0 Abandon Keep]
2733	if !$decision {
2734	set expgui(temp) "Quit"
2735	destroy $w
2736	}
2737	} else {
2738	set expgui(temp) "Quit"
2739	destroy $w
2740	}
2741	}
2742
2743	# this probably needs work
2744	proc editglobalparm {cmd variable title "histlist {}" "phase {}"} {
2745	global expgui expmap
2746	set w .global
2747	catch {destroy $w}
2748	toplevel $w -bg beige
2749	wm title $w "Edit Global Parameter"
2750	set expgui(temp) {}
2751	if {[llength $histlist] == 0} {
2752	set hist {}
2753	foreach n $expgui(curhist) {
2754	lappend hist [lindex $expmap(powderlist) $n]
2755	}
2756	} else {
2757	set hist $histlist
2758	}
2759	pack [frame $w.0 -bd 6 -relief groove -bg beige] \
2760	-side top -expand yes -fill both
2761	grid [label $w.0.a -text "Setting $title for histograms [CompressList $hist]"\
2762	-bg beige] \
2763	-row 0 -column 0 -columnspan 10
2764	grid [entry $w.0.b -textvariable expgui(temp)] \
2765	-row 1 -column 0
2766
2767
2768	pack [frame $w.b -bg beige] -fill x -expand yes -side top
2769	pack [button $w.b.2 -text Set -command "destroy $w"] -side left
2770	pack [button $w.b.3 -text Quit -command "set expgui(temp) {}; destroy $w"] -side left
2771	pack [button $w.b.help -text Help -bg yellow \
2772	-command "MakeWWWHelp expgui3.html EditParm"] -side right
2773	bind $w <Key-F1> "MakeWWWHelp expgui3.html EditParm"
2774	bind $w <Return> "destroy $w"
2775
2776	# force the window to stay on top
2777	putontop $w
2778	focus $w.b.2
2779	tkwait window $w
2780	afterputontop
2781
2782	if {$expgui(temp) != ""} {
2783	foreach h $hist {
2784	if {$cmd == "histinfo"} {
2785	histinfo $h $variable set $expgui(temp)
2786	incr expgui(changed)
2787	if $expgui(debug) {
2788	puts "histinfo $h $variable set $expgui(temp)"
2789	}
2790	} elseif {$cmd == "hapinfo"} {
2791	hapinfo $h $phase $variable set $expgui(temp)
2792	incr expgui(changed)
2793	if $expgui(debug) {
2794	puts "hapinfo $phase $h $variable set $expgui(temp)"
2795	}
2796	} else {
2797	error "$cmd unimplemented"
2798	}
2799	}
2800	}
2801	}
2802
2803	proc EditProfile {title histlist phaselist} {
2804	global expgui expmap entrycmd
2805	set w .back
2806	catch {destroy $w}
2807	toplevel $w -bg beige
2808	wm title $w "Global Edit Profile"
2809	set hist [lindex $histlist 0]
2810	set phase [lindex $phaselist 0]
2811	set ptype [string trim [hapinfo $hist $phase proftype]]
2812	set htype [string range $expmap(htype_$hist) 2 2]
2813	set nterms [hapinfo $hist $phase profterms]
2814
2815	pack [frame $w.0 -bd 6 -relief groove -bg beige \
2816	] -side top -expand yes -fill both
2817	grid [label $w.0.a \
2818	-text "Setting profile terms: $title" \
2819	-bg beige] -row 0 -column 0 -columnspan 10
2820	grid [label $w.0.b -text "Function type $ptype" -bg beige] -row 1 -column 0
2821	grid [label $w.0.c -text " Peak cutoff" -bg beige] -row 1 -column 3
2822	grid [entry $w.0.d -width 10 ] -row 1 -column 4
2823	set entrylist {}
2824	lappend entrylist "pcut $w.0.d"
2825
2826	set col -1
2827	set row 1
2828	set lbls "dummy [GetProfileTerms $phase $hist $ptype]"
2829	pack [frame $w.1 -bd 6 -relief groove -bg beige \
2830	] -side top -expand yes -fill both
2831	for { set num 1 } { $num <= $nterms } { incr num } {
2832	set term {}
2833	catch {set term [lindex $lbls $num]}
2834	if {$term == ""} {set term $num}
2835	incr col
2836	grid [label $w.1.l${num} -text "$term" -bg beige] \
2837	-row $row -column $col
2838	incr col
2839	grid [entry $w.1.ent${num} \
2840	-width 14] -row $row -column $col
2841	lappend entrylist "pterm$num $w.1.ent${num}"
2842	if {$col > 6} {set col -1; incr row}
2843	}
2844	pack [frame $w.b -bg beige] -fill x -expand yes -side top
2845	grid [button $w.b.2 -text Set \
2846	-command "SetEditProfile [list $entrylist] [list $phaselist] \
2847	[list $histlist] $w"] -row 0 -column 1
2848	grid [button $w.b.3 -text Quit \
2849	-command "QuitEditProfile $w [list $entrylist]"] -row 0 -column 2
2850	grid [button $w.b.help -text Help -bg yellow \
2851	-command "MakeWWWHelp expgui5.html GlobalEdit"] \
2852	-row 0 -column 4
2853	grid columnconfig $w.b 0 -weight 1
2854	grid columnconfig $w.b 3 -weight 1
2855	bind $w <Key-F1> "MakeWWWHelp expgui5.html GlobalEdit"
2856	bind $w <Return> "QuitEditProfile $w [list $entrylist]"
2857
2858	# force the window to stay on top
2859	putontop $w
2860	focus $w.b.2
2861	tkwait window $w
2862	afterputontop
2863	}
2864
2865	proc SetEditProfile {entrylist phaselist histlist w} {
2866	global expgui
2867	foreach item $entrylist {
2868	set value [ [lindex $item 1] get ]
2869	if {$value != ""} {
2870	hapinfo $histlist $phaselist [lindex $item 0] set $value
2871	incr expgui(changed)
2872	if $expgui(debug) {
2873	puts "hapinfo [list $phaselist] [list $histlist] [lindex $item 0] set $value"
2874	}
2875	}
2876	}
2877	destroy $w
2878	}
2879
2880	proc QuitEditProfile {w entrylist} {
2881	global expgui
2882	# lets find out if anything changed
2883	set changed 0
2884	foreach item $entrylist {
2885	if {[ [lindex $item 1] get ] != ""} {set changed 1; break}
2886	}
2887	if $changed {
2888	set decision [tk_dialog .changes "Abandon Changes" \
2889	"You have made changes to the Profile. Ok to abandon changes?" \
2890	warning 0 Abandon Keep]
2891	if !$decision {destroy $w}
2892	} else {
2893	destroy $w
2894	}
2895	}
2896
2897	# this is called to change the absorption correction mode and to
2898	# change the absorption correction model.
2899	proc editabsorption {} {
2900	global expgui expmap
2901	set histlist {}
2902	foreach n $expgui(curhist) {
2903	lappend histlist [lindex $expmap(powderlist) $n]
2904	}
2905	if {[llength $histlist] == 0} return
2906
2907	set w .abs
2908	catch {destroy $w}
2909	toplevel $w -bg beige
2910	if {$expgui(globalmode) != 0} {
2911	wm title $w "Global Edit Absorption/Reflectivity"
2912	} else {
2913	wm title $w "Edit Absorption/Reflectivity"
2914	}
2915
2916	pack [frame $w.0 -bd 6 -relief groove -bg beige \
2917	] -side top -expand yes -fill both
2918	if {[llength $histlist] > 1} {
2919	grid [label $w.0.a \
2920	-text "Changing settings for histograms [CompressList $histlist]" \
2921	-bg beige] -row 0 -column 0 -columnspan 10
2922	} else {
2923	grid [label $w.0.a \
2924	-text "Changing settings for histogram $histlist" \
2925	-bg beige] -row 0 -column 0 -columnspan 4
2926	#grid columnconfig $w.0 4 -weight 1
2927	}
2928	grid rowconfig $w.0 1 -min 10
2929	set hist [lindex $histlist 0]
2930
2931	grid [label $w.0.lb1 -text "Absorption Coefficient(s)" -bg beige] \
2932	-row 2 -column 1 -columnspan 2
2933	grid [label $w.0.lb1a -text "1" -bg beige] -row 3 -column 1
2934	set expgui(abs2box1) $w.0.lb2a
2935	grid [label $w.0.lb2a -text "2" -bg beige] -row 3 -column 2
2936	grid [label $w.0.lb3 -text Absorption\nFunction -bg beige] \
2937	-row 2 -column 6 -rowspan 2 -columnspan 2
2938	grid [entry $w.0.ent1 -textvariable expgui(abscor1) -width 15] \
2939	-row 4 -column 1
2940	set expgui(abs2box2) $w.0.ent2
2941	grid [entry $w.0.ent2 -textvariable expgui(abscor2) -width 15] \
2942	-row 4 -column 2
2943	trace vdelete expgui(abstype) w AbsSetoptmsg
2944	eval tk_optionMenu $w.0.m1 expgui(abstype) 0 1 2 3 4
2945	trace variable expgui(abstype) w AbsSetoptmsg
2946	grid $w.0.m1 -row 4 -column 6 -columnspan 2
2947	grid [label $w.0.lb8 -textvariable expgui(opttxt) -bg beige \
2948	-wrap 300 -justify left] -row 5 -column 1 -sticky ne -columnspan 7
2949	grid rowconfig $w.0 5 -min 100
2950	# set the values, note the trace on abstype
2951	foreach var {abscor1 abscor2 abstype} {
2952	set expgui($var) [histinfo $hist $var]
2953	}
2954
2955	pack [frame $w.b -bg beige] -fill x -expand yes -side top
2956	grid [button $w.b.2 -text Set -command "AbsSaveEdit $w [list $histlist]"] \
2957	-row 0 -column 1
2958	grid [button $w.b.3 -text Quit \
2959	-command "destroy $w"] -row 0 -column 2
2960	grid [button $w.b.help -text Help -bg yellow \
2961	-command "MakeWWWHelp expgui3.html EditAbsorption"] \
2962	-row 0 -column 4
2963	grid columnconfig $w.b 0 -weight 1
2964	grid columnconfig $w.b 3 -weight 1
2965	bind $w <Key-F1> "MakeWWWHelp expgui3.html EditAbsorption"
2966	bind $w <Return> "destroy $w"
2967
2968	# force the window to stay on top
2969	putontop $w
2970
2971	focus $w.b.2
2972	tkwait window $w
2973	afterputontop
2974	}
2975
2976	proc AbsSetoptmsg {args} {
2977	global expgui
2978	array set opttxt {
2979	0 "Correction for cylindrical samples [Lobanov & Alte da Veiga]. OK for all data types, but not for Bragg-Brentano flat-plate geometry. Set term 1 to muR/lambda (TOF: muR for lambda=1). For CW x-ray/neutron, do not refine!"
2980	1 "Wavelength-dependent correction for container penetration. Use with TOF & Energy Disp x-ray only."
2981	2 "Surface roughness correction [Pitschke, Hermann & Muttern]. Use with flat-plate reflection geometry (usually Bragg-Brentano) only."
2982	3 "Surface roughness correction, [Suortti]. Use with flat-plate reflection geometry (usually Bragg-Brentano) only."
2983	4 "Flat plate samples in transmission mode. OK for all data types, but not Bragg-Brentano geometry. Term 2 is angle w/r to beam (usually 0). For CW, do not refine."
2984	}
2985	set expgui(opttxt) ""
2986	catch {set expgui(opttxt) [set opttxt($expgui(abstype))]}
2987	switch $expgui(abstype) {
2988	0 -
2989	1 {
2990	$expgui(abs2box1) config -fg gray
2991	$expgui(abs2box2) config -state disabled -fg gray
2992	}
2993	2 -
2994	3 -
2995	4 {
2996	$expgui(abs2box1) config -fg black
2997	$expgui(abs2box2) config -state normal -fg black
2998	}
2999	default {
3000	set expgui(opttxt) "Please select an absorption function"
3001	}
3002	}
3003	}
3004	proc AbsSaveEdit {top histlist} {
3005	global expgui expmap
3006	# sanity check: look at the histogram type
3007	set h [lindex $histlist 0]
3008	if {[string range $expmap(htype_$h) 2 2] == "T"} {set flag 1}
3009	if {[string range $expmap(htype_$h) 1 2] == "NC"} {set flag 2}
3010	if {[string range $expmap(htype_$h) 1 2] == "XC" && \
3011	[histinfo $h lam2] != 0.0} {set flag 3}
3012	if {[string range $expmap(htype_$h) 1 2] == "XC" && \
3013	[histinfo $h lam2] == 0.0} {set flag 4}
3014	if {[string range $expmap(htype_$h) 1 2] == "XE"} {set flag 5}
3015
3016	set msg {}
3017	if {$expgui(abstype) == 0 && ($flag == 3 \|\| $flag == 4)} {
3018	set msg "Mode 0 is appropriate for cylindrical (Debye-Scherrer) geometry only"
3019	} elseif {$expgui(abstype) == 1 && ($flag != 1 && $flag != 5)} {
3020	set msg "Mode 1 is appropriate for wavelength-dispersive (TOF/E.D. X-ray) data only"
3021	} elseif {($expgui(abstype) == 2 \|\| $expgui(abstype) == 3) \
3022	&& $flag != 3 && $flag != 4} {
3023	set msg "Mode 1 is appropriate for reflection geometry flat-plate (typically Bragg-Brentano) data only"
3024	} elseif {$expgui(abstype) == 4 && $flag <= 3} {
3025	set msg "Mode 4 is appropriate for flat-plate samples in transmission"
3026	}
3027	if {$msg != ""} {
3028	set result [\
3029	MyMessageBox -parent $top -title "Sanity check" \
3030	-type okcancel -default cancel \
3031	-icon warning -helplink "expgui3.html AbsorptionSanity" \
3032	-message "$msg -- are you sure you want to do this?"]
3033	if {$result == "cancel"} return
3034	}
3035
3036	# validate abscor1 & abscor2 (if needed)
3037	set msg {}
3038	if {![validreal expgui(abscor1) 15 8]} {
3039	set msg "Term 1 is invalid"
3040	}
3041	if {$expgui(abstype) > 1} {
3042	if {![validreal expgui(abscor2) 15 8]} {
3043	if {$msg != ""} {append msg "\n"}
3044	append msg "Term 2 is invalid"
3045	}
3046	}
3047	if {$msg != ""} {
3048	MyMessageBox -parent $top -title "Entry error" \
3049	-type ok -default ok \
3050	-icon warning -helplink "" \
3051	-message "Invalid data entered. Please correct.\n$msg"
3052	return
3053	}
3054
3055	histinfo $histlist abstype set $expgui(abstype)
3056	histinfo $histlist abscor1 set $expgui(abscor1)
3057	if {$expgui(abstype) > 1} {
3058	histinfo $histlist abscor2 set $expgui(abscor2)
3059	} else {
3060	histinfo $histlist abscor2 set 0.
3061	}
3062	# turn off refinement, just in case they didn't read
3063	if {($expgui(abstype) == 0 \|\| $expgui(abstype) == 1 \|\| $expgui(abstype) == 4) \
3064	&& ($flag != 1 && $flag != 5)} {
3065	histinfo $histlist absref set 0
3066	}
3067	incr expgui(changed)
3068	destroy $top
3069	}
3070
3071	##############################################################################
3072	## #############################################
3073	## END OF THE PROCEDURES SECTION #############################################
3074	## #############################################
3075	##############################################################################
3076
3077	# <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
3078	# <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< <<<<<<<<<<<<<<<<<<<
3079	# <<<<<<<<<<<<<<<<<<<<<<<<<<<<<< BEGIN: GUI SECTION >>>>>>>>>>>>>>>>>>>
3080	# >>>>>>>>>>>>>>>>>>>>>>>>>>>>>> >>>>>>>>>>>>>>>>>>>
3081	# >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
3082	# A frame for menu items at top of display
3083	set expgui(fm) [frame .fm -relief raised -borderwidth 2 -width 150 -height 40]
3084	# Pack the menu frame.
3085	pack $expgui(fm) -fill x -side top -anchor n
3086
3087	# create a button bar
3088	pack [frame .bar -relief raised -bd 2 -bg beige] -fill x -side top -anchor n
3089
3090	# Creating the notebook and panes
3091
3092	# create an array element describing each notebook page (used with BW only)
3093	# element 0 -- pane name
3094	# 1 -- Label on frame
3095	# 2 -- initialization command
3096	# 3 -- update command
3097	# 4 -- 0/1 Use 1 if pane should be disabled in when all histograms
3098	# are selected in global mode, 0 otherwise
3099	# 5 -- Web page for pane
3100	# 6 -- name anchor on Web page for pane
3101	set expgui(notebookpagelist) {
3102	{lsFrame "LS Controls" \
3103	"" \
3104	SetupExtractHist \
3105	0 expgui1.html ""}
3106	{phaseFrame Phase \
3107	"" \
3108	{SelectOnePhase $expgui(curPhase)} \
3109	0 expgui2.html ""}
3110	{histFrame Histogram \
3111	MakeHistPane \
3112	DisplayHistogram \
3113	1 expgui3.html ""}
3114	{fracFrame Scaling \
3115	MakeScalingPane \
3116	DisplayFrac \
3117	0 expgui4.html ""}
3118	{profFrame Profile \
3119	MakeProfilePane \
3120	DisplayProfile \
3121	1 expgui5.html ""}
3122	{consFrame Constraints \
3123	"source [file join $expgui(scriptdir) atomcons.tcl]; MakeConstraintsPane" \
3124	DisplayConstraintsPane \
3125	0 expgui6.html ""}
3126	{orientFrame "MD Pref Orient" \
3127	MakeOrientPane \
3128	DisplayOrient \
3129	0 expgui7.html MD}
3130	{odfFrame "SH Pref Orient" \
3131	"source [file join $expgui(scriptdir) odf.tcl]; MakeODFPane" \
3132	DisplayODFPane \
3133	0 expgui7.html ODF}
3134	}
3135
3136	if $expgui(haveBW) {
3137	pack [NoteBook .n -bd 2] -expand yes -fill both
3138	# this should not be needed, but for some reason NoteBook is not
3139	# using the optionDB
3140	catch {.n configure -font [option get .n font Canvas]}
3141	foreach item $expgui(notebookpagelist) {
3142	set frm [lindex $item 0]
3143	set expgui($frm) [\
3144	.n insert end $frm -text [lindex $item 1] \
3145	-createcmd "set expgui(pagenow) $frm; [lindex $item 2]" \
3146	-raisecmd "set expgui(pagenow) $frm; [lindex $item 3]"]
3147
3148	# at this time expgui(frameactionlist) is generated
3149	# from expgui(notebookpagelist), but in the future it might
3150	# make sense to use expgui(notebookpagelist) directly
3151	lappend expgui(frameactionlist) "$frm [list [lindex $item 3]]"
3152
3153	# panes to disable in global "all" mode
3154	if {[lindex $item 4]} {
3155	lappend expgui(GlobalModeAllDisable) \
3156	"$frm \{.n itemconfigure $frm\}"
3157	}
3158	}
3159	} else {
3160	Notebook:create .n \
3161	-pages {lsFrame phaseFrame histFrame fracFrame profFrame}
3162	pack .n -anchor w -fill both -expand yes
3163	foreach item {lsFrame phaseFrame histFrame fracFrame profFrame \
3164	orientFrame} \
3165	page {"LS Controls" Phase Histogram Scaling Profile \
3166	"MD Pref Orient"} {
3167	set expgui($item) [Notebook:frame .n $item]
3168	Notebook:pageconfig .n $item -command "InitPage $item" -title $page
3169	}
3170	lappend expgui(frameactionlist) "lsFrame SetupExtractHist"
3171	lappend expgui(frameactionlist) "phaseFrame {DisplayAllAtoms $expgui(curPhase) noreset}"
3172	lappend expgui(frameactionlist) "histFrame DisplayHistogram"
3173	lappend expgui(frameactionlist) "fracFrame DisplayFrac"
3174	lappend expgui(frameactionlist) "profFrame DisplayProfile"
3175	lappend expgui(frameactionlist) "orientFrame DisplayOrient"
3176	set expgui(GlobalModeAllDisable) {}
3177	lappend expgui(GlobalModeAllDisable) "histFrame {Notebook:pageconfig .n histFrame}"
3178	lappend expgui(GlobalModeAllDisable) "profFrame {Notebook:pageconfig .n profFrame}"
3179	}
3180
3181	# this is used to bring up the selected frame
3182	proc RaisePage {nextpage} {
3183	global expgui
3184	if $expgui(haveBW) {
3185	set expgui(pagenow) $nextpage
3186	.n see $nextpage
3187	.n raise $nextpage
3188	} else {
3189	Notebook:raise .n $nextpage
3190	InitPage $nextpage
3191	}
3192	}
3193	# this is only called when BWidget is not in use
3194	proc InitPage {nextpage} {
3195	global expgui
3196	set expgui(pagenow) $nextpage
3197	UpdateCurrentPage
3198	}
3199	# resize the notebook to fit all the tabs and the largest page
3200	proc ResizeNotebook {} {
3201	global expgui
3202	if {$expgui(haveBW)} {
3203	.n compute_size
3204	} else {
3205	Notebook:resize .n
3206	}
3207	}
3208
3209	#----------------------------------------------------------------------------
3210	proc MakePhasePane {} {
3211	#\/ \/ \/ \/ \/ \/ \/ BEGINNING OF PHASE PANE CODE \/ \/ \/ \/ \/ \/ \/
3212	global expgui entryvar entrybox entrycmd
3213	frame $expgui(phaseFrame).top
3214	set frameLatt [frame $expgui(phaseFrame).frameLatt]
3215	# This is a big frame in the Phase notebook pane to hold atomic data.
3216	set fbig [frame $expgui(phaseFrame).fbig -width 180 \
3217	-relief raised -borderwidth 4 -class Coord]
3218	# This is a frame just below the big frame: for edits
3219	set frame3 [frame $expgui(phaseFrame).frame3 -width 100 \
3220	-relief raised -borderwidth 4 -bg $expgui(bkgcolor1)]
3221
3222	grid $expgui(phaseFrame).top -sticky news -row 0 -column 0
3223	grid $frameLatt -sticky news -row 2 -column 0
3224	grid $fbig -sticky news -row 3 -column 0
3225	# give extra space to the atoms box
3226	grid columnconfigure $expgui(phaseFrame) 0 -weight 1
3227	grid rowconfigure $expgui(phaseFrame) 3 -weight 1
3228	grid $frame3 -sticky news -row 4 -column 0
3229	grid columnconfigure $expgui(phaseFrame) 0 -weight 1
3230	grid rowconfigure $expgui(phaseFrame) 3 -weight 1
3231	grid [frame $expgui(phaseFrame).top.ps] -column 0 -row 0 -sticky w
3232	# this is where the buttons will go
3233	pack [label $expgui(phaseFrame).top.ps.0 -text "No Phases"] -side left
3234
3235	grid [label $expgui(phaseFrame).top.lA -text title: \
3236	-fg blue ] -column 1 -row 0 -sticky e
3237	grid [entry $expgui(phaseFrame).top.lB -textvariable entryvar(phasename) \
3238	-fg blue -width 45] -column 2 -row 0 -sticky e
3239	grid columnconfigure $expgui(phaseFrame).top 1 -weight 1
3240	# ------------- Lattice Parameter Box ------------------
3241	set row 0
3242	foreach col {2 4 6} var {a b c} lbl {a b c} {
3243	grid [label $frameLatt.l$var -text $lbl] \
3244	-column $col -row $row -padx 5 -sticky e
3245	incr col
3246	grid [label $frameLatt.e$var -textvariable entryvar($var) \
3247	-relief groove -bd 2 -width 10] \
3248	-column $col -row $row -padx 5
3249	# grid [entry $frameLatt.e$var -textvariable entryvar($var) -width 10] \
3250	# -column $col -row $row -padx 5
3251	# set entrybox($var) $frameLatt.e$var
3252	}
3253	incr row
3254	foreach col {2 4 6} var {alpha beta gamma} lbl {a b g} {
3255	grid [label $frameLatt.l$var -text $lbl] \
3256	-column $col -row $row -padx 5 -sticky e
3257	set font [$frameLatt.l$var cget -font]
3258	$frameLatt.l$var config -font "Symbol [lrange $font 1 end]"
3259
3260	incr col
3261	grid [label $frameLatt.e$var -textvariable entryvar($var)\
3262	-relief groove -bd 2 -width 10] \
3263	-column $col -row $row -padx 5
3264	# grid [entry $frameLatt.e$var -textvariable entryvar($var) -width 10] \
3265	# -column $col -row $row -padx 5
3266	# set entrybox($var) $frameLatt.e$var
3267	}
3268
3269	grid [button $frameLatt.edit -text "Edit\nCell" -command EditCellConstants] \
3270	-column 8 -row 0 -rowspan 2 -padx 5 -sticky e
3271	grid [label $frameLatt.lr -text "Refine Cell"] -column 9 -row 0 -padx 5 -sticky e
3272	grid [label $frameLatt.ld -text "Cell damping"] -column 9 -row 1 -padx 5 -sticky e
3273	set cFlag [checkbutton $frameLatt.c -text "" -variable entryvar(cellref)]
3274	grid $cFlag -column 10 -row 0 -padx 5 -sticky e
3275	tk_optionMenu $frameLatt.om entryvar(celldamp) 0 1 2 3 4 5 6 7 8 9
3276	grid $frameLatt.om -column 10 -row 1 -padx 5 -sticky e
3277	grid [label $frameLatt.phasetype -textvariable expgui(phasetype) -fg blue] \
3278	-column 1 -row 0 -rowspan 2
3279	if [file executable $expgui(exptool)] {
3280	grid [button $expgui(phaseFrame).frameLatt.newp \
3281	-text "Add\nPhase" -padx 1.5m -command MakeAddPhaseBox \
3282	] -column 0 -row 0 -rowspan 2 -sticky w
3283	}
3284	grid columnconfig $frameLatt 1 -weight 1
3285	grid columnconfig $frameLatt 0 -weight 1
3286	#-------------- Begin Atom Coordinates Box ------------------------------
3287	grid [listbox $fbig.title -height 1 -relief flat \
3288	-exportselection 0 -bg lightgrey -fg black \
3289	-selectforeground black -selectbackground lightgrey] \
3290	-row 0 -column 0 -sticky ew
3291	set expgui(atomtitle) $fbig.title
3292	bind $expgui(atomtitle) <Button-1> {
3293	set i [lsearch {number type mult x y z occupancy} $expgui(asorttype)]
3294	incr i
3295	set expgui(asorttype) [lindex {number type mult x y z occupancy number} $i]
3296	DisplayAllAtoms $expgui(curPhase)
3297	}
3298	bind $expgui(atomtitle) <Button-3> {set expgui(asorttype) number; DisplayAllAtoms $expgui(curPhase)}
3299
3300	$expgui(atomtitle) configure -selectmode extended
3301	grid [listbox $fbig.lbox -height 10 \
3302	-exportselection 0 \
3303	-xscrollcommand " $fbig.bscr set"\
3304	-yscrollcommand " $fbig.rscr set"\
3305	] -row 1 -column 0 -sticky news
3306	set expgui(atomlistbox) $fbig.lbox
3307	$expgui(atomlistbox) configure -selectmode extended
3308	grid [scrollbar $fbig.bscr -orient horizontal \
3309	-command "move2boxesX \" $fbig.title $fbig.lbox \" " \
3310	] -row 2 -column 0 -sticky ew
3311	grid [scrollbar $fbig.rscr -command "$fbig.lbox yview" \
3312	] -row 1 -column 1 -sticky ns
3313	# give extra space to the atoms box
3314	grid columnconfigure $fbig 0 -weight 1
3315	grid rowconfigure $fbig 1 -weight 1
3316
3317	# BIND mouse in editbox
3318	bind $expgui(atomlistbox) <ButtonRelease-1> editRecord
3319	bind $expgui(atomlistbox) <Button-3> SelectAllAtoms
3320
3321	#-------------- End Atoms Section ---------------------------------
3322
3323	# --------------------------- Begin Edit Box ------------------------
3324	grid [set expgui(EditingAtoms) [label $frame3.top -bg $expgui(bkgcolor1) -fg blue]] \
3325	-column 0 -row 0 -padx 2 -pady 3 -columnspan 10 -sticky w
3326	if [file executable $expgui(exptool)] {
3327	button $frame3.newa -text "Add New Atoms" \
3328	-bg $expgui(bkgcolor1) -highlightthickness 0 \
3329	-command {MakeAddAtomsBox $expgui(curPhase)}
3330	grid $frame3.newa -column 11 -row 0
3331	set expgui(AddAtomBut) $frame3.newa
3332	}
3333	button [set expgui(atomxform) $frame3.xa] \
3334	-bg $expgui(bkgcolor1) -highlightthickness 0 \
3335	-command {MakeXformAtomsBox $expgui(curPhase)}
3336	grid $expgui(atomxform) -column 11 -row 1 -sticky ew
3337
3338	set f3l1 [label $frame3.l1 -text "Refinement Flags:" -bg $expgui(bkgcolor1)]
3339	grid $f3l1 -column 0 -row 1 -padx 2 -sticky nsw -pady 3
3340	foreach lbl {X U F} var {xref uref fref} col {1 2 3} {
3341	grid [checkbutton $frame3.cf$col \
3342	-text $lbl -variable entryvar($var) \
3343	-bg $expgui(bkgcolor1) -highlightthickness 0 \
3344	-activebackground $expgui(bkgcolor1)] \
3345	-column $col -row 1 -padx 4 -pady 3 -sticky w
3346	}
3347	set f3l4 [label $frame3.l4 -text " Damping:" -bg $expgui(bkgcolor1)]
3348	grid $f3l4 -column 4 -row 1 -padx 2 -sticky nsw -pady 3
3349
3350	set col 4
3351	foreach var {xdamp udamp fdamp} num {2 3 4} lbl {X U F} {
3352	grid [label $frame3.lom$num -text $lbl \
3353	-bg $expgui(bkgcolor1)] \
3354	-column [incr col] -row 1 -padx 2 -pady 3 -sticky w
3355	tk_optionMenu $frame3.om$num entryvar($var) 0 1 2 3 4 5 6 7 8 9
3356	$frame3.om$num config -highlightthickness 0
3357	grid $frame3.om$num -column [incr col] -row 1 -padx 2 -pady 3 -sticky w
3358	}
3359	set expgui(atomreflbl) "$frame3.l1 $frame3.l4 $frame3.lom2 $frame3.lom3 $frame3.lom4 "
3360	set expgui(atomref) "$frame3.cf1 $frame3.cf2 $frame3.cf3 $frame3.om2 $frame3.om3 $frame3.om4"
3361
3362	set coords [frame $frame3.coords -width 100 -borderwidth 0 -bg $expgui(bkgcolor1)]
3363	grid $coords -column 0 -row 6 -columnspan 12 -sticky nsew
3364
3365	set f3l1 [label $frame3.coords.l1 -text "Label" -bg $expgui(bkgcolor1)]
3366	grid $f3l1 -column 0 -row 4 -padx 2 -sticky nsw -pady 3
3367	set expgui(atomlabels) $f3l1
3368
3369	set f3e1 [entry $frame3.coords.e1 -textvariable entryvar(label) -width 6]
3370	grid $f3e1 -column 1 -row 4 -padx 2 -sticky nsw -pady 3
3371	set expgui(atomentry) $f3e1
3372
3373	set f3l8 [label $frame3.coords.l8 -text "Coordinates" -bg $expgui(bkgcolor1)]
3374	grid $f3l8 -column 2 -row 4 -padx 2 -sticky nsw -pady 3
3375	lappend expgui(atomlabels) $f3l8
3376	set f3l11 [label $frame3.coords.l11 -text "Occupancy" -bg $expgui(bkgcolor1)]
3377	grid $f3l11 -column 6 -row 4 -padx 2 -sticky nsw -pady 3
3378	lappend expgui(atomlabels) $f3l11
3379
3380	foreach var {x y z frac} col {3 4 5 7} {
3381	set entrybox($var) [entry $frame3.coords.e$var \
3382	-textvariable entryvar($var) -width 10]
3383	grid $entrybox($var) -column $col -row 4 -padx 2 -sticky nsw -pady 3
3384	lappend expgui(atomentry) $entrybox($var)
3385	}
3386
3387
3388	set f3f31 [frame $frame3.f3f31 -width 100 -borderwidth 0 -bg $expgui(bkgcolor1)]
3389	grid $f3f31 -column 0 -row 7 -columnspan 12
3390	set expgui(anisolabels) {}
3391	foreach lbl {13 14 15 16 17 18} txt {Uiso U22 U33 U12 U13 U23} {
3392	lappend expgui(anisolabels) [\
3393	label $f3f31.l$lbl -text $txt -bg $expgui(bkgcolor1)
3394	]
3395	}
3396	set expgui(anisoentry) {}
3397	foreach i {e13 e14 e15 e16 e17 e18} var {U11 U22 U33 U12 U13 U23} {
3398	lappend expgui(anisoentry) [\
3399	entry $f3f31.$i -textvariable entryvar($var) \
3400	-width 10]
3401	set entrybox($var) $f3f31.$i
3402	}
3403
3404	set col 0
3405	foreach item1 $expgui(anisolabels) item2 $expgui(anisoentry) {
3406	grid $item1 -column $col -row 0 -sticky nsw -pady 3
3407	incr col
3408	grid $item2 -column $col -row 0 -sticky nsw -pady 3
3409	incr col
3410	}
3411	# --------------------------- End Edit Box -------------------------
3412
3413	#/\ /\ /\ /\ /\ /\ /\ END OF PHASE PANE CODE /\ /\ /\ /\ /\ /\ /\ /\ /
3414	# resize in case the pane needs more space
3415	ResizeNotebook
3416	}
3417
3418	# called to create a window for editing unit cell constants
3419	proc EditCellConstants {} {
3420	global expgui entrybox
3421	set spg [phaseinfo $expgui(curPhase) spacegroup]
3422	set laueaxis [GetLaue $spg]
3423	set vary ""
3424	set equivL ""
3425	set equivA ""
3426	switch -exact $laueaxis {
3427	1bar {set vary "a b c alpha beta gamma"}
3428	2/ma {set vary "a b c alpha"}
3429	2/mb {set vary "a b c beta"}
3430	2/mc {set vary "a b c gamma"}
3431	mmm {set vary "a b c"}
3432	4/m -
3433	4/mmm {set vary "a c"; set equivL "a b"}
3434	3barR -
3435	"3bar mR" {
3436	set vary "a alpha"
3437	set equivL "a b c"
3438	set equivA "alpha beta gamma"
3439	}
3440	3bar -
3441	3barm1 -
3442	3bar1m -
3443	6/m -
3444	6/mmm {set vary "a c";set equivL "a b"}
3445	"m 3" -
3446	m3m {set vary a;set equivL "a b c"}
3447	default {
3448	MyMessageBox -parent . -title "Laue problem" \
3449	-message "Error processing Laue code: $laueaxis\nError in space group \"$spg\"?\nUnable to edit cell. Fix or use EXPEDT." \
3450	-icon warning -type OK -default ok \
3451	-helplink "expguierr.html BadLaue"
3452	}
3453	}
3454	set row 0
3455	set w .cell
3456	toplevel $w -bg beige
3457	wm title $w "Edit Cell Parameters"
3458	# bind $w <Key-F1> "MakeWWWHelp expgui3.html EditBackground"
3459	bind $w <Return> "set expgui(temp) 1; destroy $w"
3460	pack [label $w.l1 -bg yellow -anchor center -justify center \
3461	-text "Edit unit cell parameters for phase #$expgui(curPhase)" \
3462	] -side top -expand yes -fill both
3463	pack [label $w.l2 -bg beige -justify left \
3464	-text "title: [phaseinfo $expgui(curPhase) name]\nSpace group: $spg\nLaue class: $laueaxis" \
3465	] -side top -expand yes -fill both
3466	pack [frame $w.0 -bd 6 -relief groove -bg beige \
3467	] -side top -expand yes -fill both
3468	pack [frame $w.b -bg beige] -fill x -expand yes -side top
3469	grid [button $w.b.2 -text Set -command "set expgui(temp) 1; destroy $w"] -row 0 -column 1
3470	grid [button $w.b.3 -text Quit \
3471	-command "set expgui(temp) 0; destroy $w"] -row 0 -column 2
3472	# grid [button $w.b.help -text Help -bg yellow \
3473	# -command "MakeWWWHelp expgui3.html EditBackground"] \
3474	# -row 0 -column 4
3475
3476	global tmpvar
3477	trace variable tmpvar w TestCellEdit
3478	foreach ent {a b c alpha beta gamma} {
3479	set tmpvar($ent) [phaseinfo $expgui(curPhase) $ent]
3480	}
3481
3482	set frameLatt $w.0
3483	foreach col {2 4 6} var {a b c} lbl {a b c} {
3484	grid [label $frameLatt.l$var -text $lbl -bg beige] \
3485	-column $col -row $row -padx 5 -sticky e
3486	incr col
3487	if {[lsearch $equivL $var] == -1} {
3488	set v $var
3489	} else {
3490	set v [lindex $equivL 0]
3491	}
3492	if {[lsearch $vary $var] == -1} {
3493	grid [label $frameLatt.e$var -textvariable tmpvar($v) \
3494	-width 10 -bg beige] \
3495	-column $col -row $row -padx 5
3496	} else {
3497	grid [entry $frameLatt.e$var -textvariable tmpvar($v) \
3498	-width 10] -column $col -row $row -padx 5
3499	set entrybox($var) $frameLatt.e$var
3500	}
3501	}
3502	incr row
3503	foreach col {2 4 6} var {alpha beta gamma} lbl {a b g} {
3504	grid [label $frameLatt.l$var -text $lbl -bg beige] \
3505	-column $col -row $row -padx 5 -sticky e
3506	set font [$frameLatt.l$var cget -font]
3507	$frameLatt.l$var config -font "Symbol [lrange $font 1 end]"
3508
3509	incr col
3510	if {[lsearch $equivA $var] == -1} {
3511	set v $var
3512	} else {
3513	set v [lindex $equivA 0]
3514	}
3515	if {[lsearch $vary $var] == -1} {
3516	grid [label $frameLatt.e$var -textvariable tmpvar($v)\
3517	-width 10 -bg beige] \
3518	-column $col -row $row -padx 5
3519	} else {
3520	grid [entry $frameLatt.e$var -textvariable tmpvar($v) \
3521	-width 10] -column $col -row $row -padx 5
3522	set entrybox($var) $frameLatt.e$var
3523	}
3524	}
3525	putontop $w
3526	tkwait window $w
3527	afterputontop
3528	global entryvar
3529	set change 0
3530	if {$expgui(temp)} {
3531	foreach var {a b c} {
3532	if {[lsearch $equivL $var] == -1} {
3533	set v $var
3534	} else {
3535	set v [lindex $equivL 0]
3536	}
3537	catch {
3538	expr [set val $tmpvar($v)]
3539	if {[phaseinfo $expgui(curPhase) $var] != $val} {
3540	phaseinfo $expgui(curPhase) $var set $val
3541	set entryvar($var) $val
3542	incr expgui(changed)
3543	set change 1
3544	}
3545	}
3546	}
3547	foreach var {alpha beta gamma} {
3548	if {[lsearch $equivA $var] == -1} {
3549	set v $var
3550	} else {
3551	set v [lindex $equivA 0]
3552	}
3553	catch {
3554	expr [set val $tmpvar($v)]
3555	if {[phaseinfo $expgui(curPhase) $var] != $val} {
3556	phaseinfo $expgui(curPhase) $var set $val
3557	set entryvar($var) $val
3558	incr expgui(changed)
3559	set change 1
3560	}
3561	}
3562	}
3563	if {$change} {
3564	# set the powpref warning (1 = suggested)
3565	if {$expgui(needpowpref) == 0} {set expgui(needpowpref) 1}
3566	append expgui(needpowpref_why) "\tCell parameters were changed\n"
3567	}
3568	}
3569	unset tmpvar
3570	}
3571
3572	# highlight errors in unit cell constants
3573	proc TestCellEdit {var elem mode} {
3574	global tmpvar entrybox
3575	if {[catch {expr $tmpvar($elem)} errmsg]} {
3576	catch {$entrybox($elem) config -fg red}
3577	} else {
3578	catch {$entrybox($elem) config -fg black}
3579	}
3580	}
3581
3582	#-----------------------------------------------------------------------------
3583	proc MakeHistPane {} {
3584	#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
3585	global expgui
3586
3587	grid columnconfigure $expgui(histFrame) 0 -weight 1
3588	grid rowconfigure $expgui(histFrame) 1 -weight 1
3589	grid rowconfigure $expgui(histFrame) 2 -weight 1
3590	grid rowconfigure $expgui(histFrame) 3 -weight 1
3591
3592	grid [frame $expgui(histFrame).hs -class HistList] \
3593	-column 0 -row 0 -rowspan 10 -sticky nsew
3594	MakeHistBox $expgui(histFrame).hs
3595	bind $expgui(histFrame).hs.lbox <ButtonRelease-1> {
3596	set expgui(curhist) [$expgui(histFrame).hs.lbox curselection]
3597	DisplayHistogram
3598	}
3599	bind $expgui(histFrame).hs.lbox <Button-3> {
3600	if $expgui(globalmode) {
3601	$expgui(histFrame).hs.lbox selection set 0 end
3602	set expgui(curhist) [$expgui(histFrame).hs.lbox curselection]
3603	DisplayHistogram
3604	}
3605	}
3606
3607	frame $expgui(histFrame).top -borderwidth 4 -relief groove
3608	grid [label $expgui(histFrame).top.txt] -row 0 -column 0
3609	if $expgui(haveBW) {
3610	foreach item {backBox diffBox absBox} num {2 3 4} \
3611	title {Background "Diffractometer Constants" \
3612	"Absorption/Reflectivity Correction"} {
3613	TitleFrame $expgui(histFrame).$item \
3614	-borderwidth 4 -side left -relief groove -text $title
3615	set expgui($item) [$expgui(histFrame).$item getframe]
3616	grid $expgui(histFrame).$item -column 1 -row $num -sticky nsew
3617	grid rowconfigure $expgui(histFrame) $num -minsize 100
3618	}
3619	} else {
3620	foreach item {backBox diffBox absBox} num {1 2 3} \
3621	title {Background "Diffractometer Constants" \
3622	"Absorp./Reflect. Corr"} {
3623	frame $expgui(histFrame).$item -borderwidth 4 -relief groove
3624	grid $expgui(histFrame).$item -column 1 -row $num -sticky nsew
3625	set expgui($item) $expgui(histFrame).$item
3626	grid [label $expgui(histFrame).$item.title -text $title] \
3627	-row 0 -column 0 -columnspan 10 -sticky nw
3628	}
3629	}
3630
3631	grid [frame $expgui(histFrame).bb] -column 1 -row 6
3632	if [file executable $expgui(exptool)] {
3633	button $expgui(histFrame).bb.newh -text "Add New\nHistogram" \
3634	-command MakeAddHistBox
3635	grid $expgui(histFrame).bb.newh -column 0 -row 1
3636	}
3637	button $expgui(histFrame).bb.excl \
3638	-text "Set Data Limits &\nExcluded Regions" -command excledit
3639	grid $expgui(histFrame).bb.excl -column 1 -row 1
3640
3641	button $expgui(histFrame).bb.use -text "Set Histogram\nUse Flags" \
3642	-command SetHistUseFlags
3643	grid $expgui(histFrame).bb.use -column 2 -row 1
3644
3645	# BACKGROUND information.
3646	# <<<<<<<<<<<<<<<<<<<<<<<<< BACKGROUND <<<<<<<<<<<<<<<<<<<<<
3647	grid [frame $expgui(backBox).frm1 ] -row 0 -column 0 -columnspan 11
3648	grid [label $expgui(backBox).frm1.lBGType \
3649	-textvariable expgui(backtypelbl)] \
3650	-row 1 -column 0 -sticky nws -padx 2 -pady 3
3651	grid [label $expgui(backBox).frm1.lBGTerms \
3652	-textvariable expgui(backtermlbl)] \
3653	-row 1 -column 1 -sticky nws -padx 2 -pady 3
3654	grid [button $expgui(backBox).frm1.edit -textvariable expgui(bkglbl) \
3655	-command editbackground] \
3656	-row 1 -column 2 -columnspan 3 -sticky w -padx 2 -pady 3
3657	grid [frame $expgui(backBox).frm2 ] \
3658	-row 1 -column 0 -columnspan 11 -sticky e
3659	grid [label $expgui(backBox).frm2.lfBG -text " Refine background" ] \
3660	-row 2 -column 1 -sticky news -padx 4 -pady 3
3661	grid [checkbutton $expgui(backBox).frm2.rfBG -text "" \
3662	-variable entryvar(bref) ] \
3663	-row 2 -column 2 -sticky news -padx 4 -pady 3
3664	grid [label $expgui(backBox).frm2.lBGDamp -text Damping ] \
3665	-row 2 -column 3 -sticky w -padx 2 -pady 3
3666	tk_optionMenu $expgui(backBox).frm2.om entryvar(bdamp) 0 1 2 3 4 5 6 7 8 9
3667	grid $expgui(backBox).frm2.om \
3668	-row 2 -column 4 -sticky news -padx 4 -pady 3 -sticky e
3669	# Absorption information.
3670	grid [label $expgui(absBox).rf1 -text " Refine Abs./Refl." ] \
3671	-row 2 -column 1 -sticky news -padx 4 -pady 3
3672	grid [checkbutton $expgui(absBox).rf2 -text "" \
3673	-variable entryvar(absref) ] \
3674	-row 2 -column 2 -sticky news -padx 4 -pady 3
3675	grid [label $expgui(absBox).d1 -text Damping ] \
3676	-row 2 -column 3 -sticky w -padx 2 -pady 3
3677	tk_optionMenu $expgui(absBox).d2 entryvar(absdamp) 0 1 2 3 4 5 6 7 8 9
3678	grid $expgui(absBox).d2 \
3679	-row 2 -column 4 -sticky news -padx 4 -pady 3 -sticky e
3680	grid [button $expgui(absBox).edit -textvariable expgui(abslbl) \
3681	-command editabsorption] \
3682	-row 2 -column 5 -sticky w -padx 2 -pady 3
3683
3684	#^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^END OF HISTOGRAM PANE CODE ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^
3685	# insert the histograms & resize in case the pane needs more space
3686	sethistlist
3687	ResizeNotebook
3688	}
3689	###############################################################################
3690	proc MakeScalingPane {} {
3691	#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
3692	global expgui entryvar entrybox
3693
3694	pack [frame $expgui(fracFrame).hs -class HistList] \
3695	-side left -expand y -fill both
3696	MakeHistBox $expgui(fracFrame).hs
3697	bind $expgui(fracFrame).hs.lbox <ButtonRelease-1> {
3698	set expgui(curhist) [$expgui(fracFrame).hs.lbox curselection]
3699	DisplayFrac
3700	}
3701	bind $expgui(fracFrame).hs.lbox <Button-3> {
3702	if $expgui(globalmode) {
3703	$expgui(fracFrame).hs.lbox selection set 0 end
3704	set expgui(curhist) [$expgui(fracFrame).hs.lbox curselection]
3705	DisplayFrac
3706	}
3707	}
3708
3709	pack [frame $expgui(fracFrame).f1] -fill both -expand true
3710	# Create a large canvas area containing a frame for each phase in the data set.
3711	# The canvas and vertical scrollbar are inside a frame called f1
3712	if $expgui(haveBW) {
3713	TitleFrame $expgui(fracFrame).f1.scaleBox \
3714	-borderwidth 4 -text "Scale Factor"
3715	# -borderwidth 4 -width 600 -height 100 -label "Scale Factor"
3716	grid $expgui(fracFrame).f1.scaleBox -column 0 -row 0 -sticky nsew -columnspan 2
3717	set expgui(scaleBox) [$expgui(fracFrame).f1.scaleBox getframe]
3718	grid [label $expgui(scaleBox).histSFLabel -text Scale] \
3719	-row 1 -column 0 -sticky nws -padx 2 -pady 3
3720	} else {
3721	frame $expgui(fracFrame).f1.scaleBox -borderwidth 4 -relief groove
3722	grid $expgui(fracFrame).f1.scaleBox -column 0 -row 0 -sticky nsew -columnspan 2
3723	set expgui(scaleBox) $expgui(fracFrame).f1.scaleBox
3724	grid [label $expgui(scaleBox).histSFLabel -text "Scale Factor"] \
3725	-row 1 -column 0 -sticky nws -padx 2 -pady 3
3726	}
3727	grid [entry $expgui(scaleBox).ent1 -textvariable entryvar(scale) -width 15] \
3728	-row 1 -column 1 -sticky ew -padx 4 -pady 3
3729	set entrybox(scale) $expgui(scaleBox).ent1
3730
3731	button $expgui(scaleBox).but1 -text "Set Globally" \
3732	-command "editglobalparm histinfo scale {Scale Factor}"
3733
3734	grid [label $expgui(scaleBox).histSFRLabel -text " Refine"] \
3735	-row 1 -column 2 -sticky nws -padx 2 -pady 3
3736	grid [checkbutton $expgui(scaleBox).rf -variable entryvar(sref)] \
3737	-row 1 -column 3 -sticky news -padx 4 -pady 3
3738	grid [label $expgui(scaleBox).lD1 -text "Damping"] \
3739	-row 1 -column 4 -sticky w -padx 2 -pady 3
3740	tk_optionMenu $expgui(scaleBox).om entryvar(sdamp) 0 1 2 3 4 5 6 7 8 9
3741	grid $expgui(scaleBox).om \
3742	-row 1 -column 5 -sticky news -padx 4 -pady 3
3743	grid columnconfigure $expgui(scaleBox) 6 -weight 1
3744
3745	if $expgui(haveBW) {
3746	grid [TitleFrame $expgui(fracFrame).f1.phaseFrac -bd 4 \
3747	-text "Phase Fractions" -relief groove] \
3748	-sticky news -row 1 -column 0 -columnspan 2
3749	set PhaseFractBox [$expgui(fracFrame).f1.phaseFrac getframe]
3750	} else {
3751	set PhaseFractBox $expgui(fracFrame).f1
3752	}
3753	grid columnconfigure $expgui(fracFrame).f1 0 -weight 1
3754	grid rowconfigure $expgui(fracFrame).f1 1 -weight 1
3755
3756	grid [set expgui(FracBox) [canvas $PhaseFractBox.fracBox \
3757	-scrollregion {0 0 5000 500} \
3758	-yscrollcommand "$PhaseFractBox.yscroll set" \
3759	-width 500 -height 350 -bg lightgrey]] \
3760	-sticky news -row 1 -column 0
3761	grid [scrollbar $PhaseFractBox.yscroll \
3762	-command "$expgui(FracBox) yview" \
3763	-orient vertical] \
3764	-sticky ns -row 1 -column 1
3765	frame $expgui(FracBox).f -bd 0
3766	$expgui(FracBox) create window 0 0 -anchor nw -window $expgui(FracBox).f
3767
3768	# the rest of the page is created in DisplayFrac
3769
3770	# insert the histograms & resize in case the pane needs more space
3771	sethistlist
3772	ResizeNotebook
3773	# ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ END OF SCALING PANE CODE ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^
3774	}
3775	###############################################################################
3776	proc MakeProfilePane {} {
3777	global expgui
3778	# 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
3779	pack [frame $expgui(profFrame).hs -class HistList] \
3780	-side left -expand y -fill both
3781	MakeHistBox $expgui(profFrame).hs
3782	bind $expgui(profFrame).hs.lbox <ButtonRelease-1> {
3783	set expgui(curhist) [$expgui(profFrame).hs.lbox curselection]
3784	DisplayProfile
3785	}
3786	bind $expgui(profFrame).hs.lbox <Button-3> {
3787	if $expgui(globalmode) {
3788	$expgui(profFrame).hs.lbox selection set 0 end
3789	set expgui(curhist) [$expgui(profFrame).hs.lbox curselection]
3790	DisplayProfile
3791	}
3792	}
3793
3794	# Create a large canvas area containing a frame for each phase in the data set.
3795	# The canvas and vertical scrollbar are inside a frame called f1
3796	pack [frame $expgui(profFrame).f1] -fill both -expand true
3797	grid [set expgui(ProfileBox) [canvas $expgui(profFrame).f1.profileBox \
3798	-scrollregion {0 0 5000 500} -width 500 -height 350 -bg lightgrey]] \
3799	-sticky news -row 0 -column 0
3800	grid [scrollbar $expgui(profFrame).f1.yscroll -orient vertical] \
3801	-sticky ns -row 0 -column 1
3802
3803	$expgui(ProfileBox) config -yscrollcommand "$expgui(profFrame).f1.yscroll set"
3804	$expgui(profFrame).f1.yscroll config -command { $expgui(ProfileBox) yview }
3805
3806	grid columnconfigure $expgui(profFrame).f1 1 -weight 1
3807	grid rowconfigure $expgui(profFrame).f1 0 -weight 1
3808	frame $expgui(ProfileBox).f -bd 0
3809	$expgui(ProfileBox) create window 0 0 -anchor nw -window $expgui(ProfileBox).f
3810
3811	# insert the histograms & resize in case the pane needs more space
3812	sethistlist
3813	ResizeNotebook
3814	# ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ END OF PROFILE PANE CODE ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^
3815	}
3816
3817	##############################################################################
3818	# 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
3819	array set printopts {
3820	0 "Print the reciprocal metric tensor changes"
3821	1 "Print the correlation matrix"
3822	2 "Print the Least-Squares matrices and vectors"
3823	4 "Print the linear constraint matrices"
3824	5 "Print the applied shifts and shift factors"
3825	6 "Print the reciprocal metric tensor Var-Covar terms"
3826	7 "Print all parameters for each cycle"
3827	8 "Print summary shift/esd data after last cycle"
3828	9 "Print zero/unit pole figure constraint terms"
3829	}
3830	pack [frame $expgui(lsFrame).hs -class HistList] \
3831	-side left -expand y -fill both
3832	MakeHistBox $expgui(lsFrame).hs
3833	bind $expgui(lsFrame).hs.lbox <ButtonRelease-1> {
3834	set expgui(curhist) [$expgui(lsFrame).hs.lbox curselection]
3835	SetupExtractHist
3836	}
3837	bind $expgui(lsFrame).hs.lbox <Button-3> {
3838	if $expgui(globalmode) {
3839	$expgui(lsFrame).hs.lbox selection set 0 end
3840	set expgui(curhist) [$expgui(lsFrame).hs.lbox curselection]
3841	SetupExtractHist
3842	}
3843	}
3844
3845	pack [frame $expgui(lsFrame).f1] -fill both -expand true
3846	set row 0
3847	grid [label $expgui(lsFrame).f1.his1 -pady 6 -text "Last History:"] -row $row -column 0
3848	grid [label $expgui(lsFrame).f1.his2 -relief raised -bd 2 -pady 6 \
3849	-textvariable expgui(last_History)] \
3850	-row $row -column 1 -columnspan 5 -sticky w
3851	incr row
3852	grid [label $expgui(lsFrame).f1.tit1 -pady 6 -text "Title:"] -row $row -column 0
3853	grid [entry $expgui(lsFrame).f1.tit2 \
3854	-textvariable entryvar(title) -width 48] \
3855	-row $row -column 1 -columnspan 5 -sticky w
3856	set entrycmd(title) "expinfo title"
3857
3858	incr row
3859	grid rowconfigure $expgui(lsFrame).f1 $row -weight 1
3860	incr row
3861	grid [frame $expgui(lsFrame).f1.b -bd 4 -relief groove] \
3862	-row $row -column 0 -columnspan 2 -pady 3 -sticky s
3863	grid [label $expgui(lsFrame).f1.b.lcyc -text "Number of Cycles"] -row 0 -column 0
3864	grid [entry $expgui(lsFrame).f1.b.ecyc -width 3 \
3865	-textvariable entryvar(cycles)] -row 0 -column 1
3866	set entrybox(cycles) $expgui(lsFrame).f1.b.ecyc
3867
3868	grid [frame $expgui(lsFrame).f1.cv -bd 4 -relief groove] \
3869	-row $row -column 2 -sticky ew
3870	grid [label $expgui(lsFrame).f1.cv.l -text "Convgerence Criterion"] \
3871	-row 0 -column 0 -columnspan 2
3872	grid [label $expgui(lsFrame).f1.cv.v -textvariable expgui(convlbl)] -row 1 -column 0
3873	grid [scale $expgui(lsFrame).f1.cv.s -orient horizontal \
3874	-from -200 -to 200 -showvalue 0 -command SetConv -resolution 10 \
3875	-variable expgui(convg)] -row 1 -column 1
3876
3877	incr row
3878	grid [menubutton $expgui(lsFrame).f1.lprint -textvariable expgui(printopt) \
3879	-menu $expgui(lsFrame).f1.lprint.menu -bd 4 -relief raised \
3880	] -row $row -column 0 -columnspan 2
3881	menu $expgui(lsFrame).f1.lprint.menu
3882	foreach num [lsort [array names printopts]] {
3883	$expgui(lsFrame).f1.lprint.menu add checkbutton \
3884	-label "$printopts($num) ([expr int(pow(2,$num))])"\
3885	-variable entryvar(printopt$num)
3886	}
3887
3888	grid [frame $expgui(lsFrame).f1.marq -bd 4 -relief groove] \
3889	-row $row -column 2 -sticky ew
3890	grid [label $expgui(lsFrame).f1.marq.l -text "Marquardt Damping"] \
3891	-row 0 -column 0 -columnspan 2
3892	grid [label $expgui(lsFrame).f1.marq.v -textvariable expgui(marq)] \
3893	-row 1 -column 0
3894	grid [scale $expgui(lsFrame).f1.marq.s -orient horizontal \
3895	-from 1.0 -to 9.99 -showvalue 0 -command SetMarq -resolution 0.01 \
3896	-variable expgui(marq)] -row 1 -column 1
3897
3898	incr row
3899	grid rowconfigure $expgui(lsFrame).f1 $row -weight 1
3900
3901	incr row
3902	if {$expgui(haveBW)} {
3903	grid [TitleFrame $expgui(lsFrame).f1.a -bd 4 -relief groove \
3904	-text "Reflection Intensity Extraction" \
3905	] -row $row -column 0 -columnspan 6
3906	set expgui(FobsExtractFrame) [$expgui(lsFrame).f1.a getframe]
3907	} else {
3908	grid [frame $expgui(lsFrame).f1.a -bd 4 -relief groove \
3909	] -row $row -column 0 -columnspan 6
3910	set expgui(FobsExtractFrame) $expgui(lsFrame).f1.a
3911	}
3912
3913	grid [frame $expgui(FobsExtractFrame).c -bd 4 -relief groove] \
3914	-row 0 -column 8 -columnspan 3 -sticky ens
3915	grid [label $expgui(FobsExtractFrame).c.fol -text "Extract Fobs"] \
3916	-row 0 -column 2
3917	grid [checkbutton $expgui(FobsExtractFrame).c.foc \
3918	-variable entryvar(fobsextract)] -row 0 -column 3
3919
3920	grid [frame $expgui(FobsExtractFrame).d -bd 4 -relief groove] \
3921	-row 0 -column 3 -columnspan 5 -sticky ens
3922	grid [label $expgui(FobsExtractFrame).d.fol -text "LeBail damping"] \
3923	-row 0 -column 2
3924	tk_optionMenu $expgui(FobsExtractFrame).d.d entryvar(LBdamp) \
3925	0 1 2 3 4 5 6 7 8 9
3926	grid $expgui(FobsExtractFrame).d.d -row 0 -column 3
3927	incr row
3928	grid rowconfigure $expgui(lsFrame).f1 $row -weight 1
3929
3930
3931
3932	foreach num {1 2 3 4 5 6 7 8 9} {
3933	grid [label $expgui(FobsExtractFrame).l$num -text $num] -row 1 -column $num
3934	grid [radiobutton $expgui(FobsExtractFrame).cc$num \
3935	-command "HistExtractSet $num" \
3936	-variable expgui(Fextract$num) -value 0] \
3937	-row 2 -column $num
3938	grid [radiobutton $expgui(FobsExtractFrame).ca$num \
3939	-command "HistExtractSet $num" \
3940	-variable expgui(Fextract$num) -value 1] \
3941	-row 3 -column $num
3942	grid [radiobutton $expgui(FobsExtractFrame).cb$num \
3943	-command "HistExtractSet $num" \
3944	-variable expgui(Fextract$num) -value 2] \
3945	-row 4 -column $num
3946	}
3947	set expgui(ExtractSettingsRadiobuttons) $expgui(FobsExtractFrame).cc
3948	lappend expgui(ExtractSettingsRadiobuttons) $expgui(FobsExtractFrame).ca
3949	lappend expgui(ExtractSettingsRadiobuttons) $expgui(FobsExtractFrame).cb
3950
3951	grid [label $expgui(FobsExtractFrame).t \
3952	-text "Extraction\nMethod" -anchor c] \
3953	-column 0 -row 0 -sticky n
3954	grid [label $expgui(FobsExtractFrame).t0 -text "(Phase #)" -anchor c] \
3955	-column 10 -row 1 -sticky w
3956	grid [label $expgui(FobsExtractFrame).t1 -text "Rietveld" -anchor c] -column 0 -row 2
3957	grid [label $expgui(FobsExtractFrame).t2 -text "F(calc) Weighted" -anchor c] -column 0 -row 3
3958	grid [label $expgui(FobsExtractFrame).t3 -text "Equally Weighted" -anchor c] -column 0 -row 4
3959	grid [label $expgui(FobsExtractFrame).t2a -text "(Model biased)" -anchor c] -column 10 -row 3
3960	grid [label $expgui(FobsExtractFrame).t3a -text "(Le Bail method)" -anchor c] -column 10 -row 4
3961
3962	proc InitLSvars {} {
3963	global expgui
3964	set expgui(convg) [set expgui(convinit) [expinfo convg]]
3965	set expgui(convlbl) [format %5.2f [expr pow(10,$expgui(convg)/100.)]]
3966	set expgui(marq) [set expgui(marqinit) [expinfo marq]]
3967	}
3968	proc SetConv {x} {
3969	global expgui
3970	if {$x != $expgui(convinit) && $expgui(changed) <= 0} {
3971	incr expgui(changed)
3972	}
3973	if {$expgui(changed)} {expinfo convg set $x}
3974	set expgui(convlbl) [format %5.2f [expr {pow(10,$x/100.)}]]
3975	}
3976	proc SetMarq {x} {
3977	global expgui
3978	if {$x != $expgui(marqinit) && $expgui(changed) <= 0} {
3979	incr expgui(changed)
3980	}
3981	if {$expgui(changed)} {expinfo marq set $x}
3982	}
3983	# ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ END OF LS PANE CODE ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^
3984	#-------------------------------------------------------------------------
3985	#-------------------------------------------------------------------------
3986	#vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv THE MENU BAR vvvvvvvvvvvvvvvvvvvvvv
3987
3988	#---- file menu button
3989	menubutton $expgui(fm).file -text File -menu $expgui(fm).file.menu
3990	menu $expgui(fm).file.menu
3991	if $expgui(debug) {
3992	$expgui(fm).file.menu add command -label "Reset" -command "reset"
3993	}
3994	if {$expgui(shell)} {
3995	$expgui(fm).file.menu add command -label "Open" -command readnewexp
3996	$expgui(fm).file.menu add command -label "expnam" -command readnewexp
3997	}
3998	$expgui(fm).file.menu add command -label "Save" -underline 0 \
3999	-command savearchiveexp
4000	foreach c {s S} {bind . <Alt-$c> [list savearchiveexp]}
4001	$expgui(fm).file.menu add command -label "Save As" \
4002	-command "SaveAsFile"
4003	$expgui(fm).file.menu add command -label "Reread .EXP file" \
4004	-command {rereadexp $expgui(expfile)}
4005
4006	#---- help menu button
4007	menubutton $expgui(fm).help -text Help -menu $expgui(fm).help.menu
4008	menu $expgui(fm).help.menu
4009	$expgui(fm).help.menu add command -command showhelp -underline 0 \
4010	-label "Help Summary"
4011	$expgui(fm).help.menu add command -command MakeWWWHelp \
4012	-label "Help on current pane"
4013	$expgui(fm).help.menu add command -command "MakeWWWHelp menu" \
4014	-label "Help on menu"
4015	foreach c {h H} {bind . <Alt-$c> [list showhelp]}
4016	# define help actions
4017	bind . <Key-F1> MakeWWWHelp
4018	$expgui(fm).help.menu add command -label "About..." -command About
4019	$expgui(fm).help.menu add command -label "Cite..." -command Cite
4020
4021	#---- options menu button
4022	menubutton $expgui(fm).option -text Options \
4023	-menu $expgui(fm).option.menu
4024	menu $expgui(fm).option.menu
4025
4026	if {$expgui(shell)} {
4027	$expgui(fm).option.menu add checkbutton -label "Archive EXP" \
4028	-variable expgui(archive)
4029	$expgui(fm).option.menu add checkbutton -label "Use DISAGL window" \
4030	-variable expgui(disaglSeparateBox)
4031	$expgui(fm).option.menu add checkbutton -label "Autoload EXP" \
4032	-variable expgui(autoexpload)
4033	$expgui(fm).option.menu add checkbutton -label "Iconify during GSAS" \
4034	-variable expgui(autoiconify)
4035	if {$tcl_platform(platform) == "windows" && \
4036	$tcl_platform(os) == "Windows 95"} {
4037	$expgui(fm).option.menu add checkbutton -label "Autostart GRWND" \
4038	-variable expgui(autoGRWND)
4039	}
4040	}
4041	$expgui(fm).option.menu add cascade -menu $expgui(fm).option.menu.asort \
4042	-label "Sort atoms by"
4043
4044	set expgui(asorttype) number
4045	menu $expgui(fm).option.menu.asort
4046	foreach opt {number type mult x y z occupancy} {
4047	$expgui(fm).option.menu.asort add radiobutton -command {DisplayAllAtoms $expgui(curPhase)}\
4048	-label $opt -value $opt -variable expgui(asorttype)
4049	}
4050
4051	$expgui(fm).option.menu add cascade -menu $expgui(fm).option.menu.hsort \
4052	-label "Sort histograms by"
4053
4054	set expgui(hsorttype) number
4055	menu $expgui(fm).option.menu.hsort
4056	$expgui(fm).option.menu.hsort add radiobutton -command sethistlist \
4057	-label number -value number -variable expgui(hsorttype)
4058	$expgui(fm).option.menu.hsort add radiobutton -command sethistlist \
4059	-label "Histogram type" -value type -variable expgui(hsorttype)
4060	$expgui(fm).option.menu.hsort add radiobutton -command sethistlist \
4061	-label "Bank #" -value bank -variable expgui(hsorttype)
4062	$expgui(fm).option.menu.hsort add radiobutton -command sethistlist \
4063	-label "Angle/Wavelength" -value angle -variable expgui(hsorttype)
4064
4065	#---- Global mode menu button
4066	$expgui(fm).option.menu add cascade -menu $expgui(fm).option.menu.editmode \
4067	-label "Multiple hist. selection"
4068	menu $expgui(fm).option.menu.editmode
4069	$expgui(fm).option.menu.editmode add radiobutton -label "Off" \
4070	-variable expgui(globalmode) -value 0 \
4071	-command sethistlist
4072	$expgui(fm).option.menu.editmode add radiobutton -label "All" \
4073	-variable expgui(globalmode) -value 6 \
4074	-command sethistlist
4075	$expgui(fm).option.menu.editmode add radiobutton -label "TOF" \
4076	-variable expgui(globalmode) -value 1 \
4077	-command sethistlist
4078	$expgui(fm).option.menu.editmode add radiobutton -label "CW Neutron" \
4079	-variable expgui(globalmode) -value 2 \
4080	-command sethistlist
4081	$expgui(fm).option.menu.editmode add radiobutton -label "Alpha12 Xray" \
4082	-variable expgui(globalmode) -value 3 \
4083	-command sethistlist
4084	$expgui(fm).option.menu.editmode add radiobutton -label "Monochromatic Xray" \
4085	-variable expgui(globalmode) -value 4 \
4086	-command sethistlist
4087	$expgui(fm).option.menu.editmode add radiobutton -label "Energy Disp Xray" \
4088	-variable expgui(globalmode) -value 5 \
4089	-command sethistlist
4090	$expgui(fm).option.menu.editmode add separator
4091	$expgui(fm).option.menu.editmode add checkbutton \
4092	-label "Group phases together" \
4093	-variable expgui(globalphasemode) \
4094	-command sethistlist
4095
4096	set expgui(globalmode) 0
4097	set expgui(globalphasemode) 1
4098
4099	if {$tcl_platform(platform) == "unix"} {
4100	$expgui(fm).option.menu add checkbutton -label "Override backspace" \
4101	-variable env(GSASBACKSPACE)
4102	}
4103
4104	$expgui(fm).option.menu add cascade -menu $expgui(fm).option.menu.font \
4105	-label "Screen font"
4106	menu $expgui(fm).option.menu.font
4107	foreach f {10 11 12 13 14 16 18 20 22} {
4108	$expgui(fm).option.menu.font add radiobutton \
4109	-command {SetTkDefaultOptions $expgui(font); ResizeFont .; ResizeNotebook} \
4110	-label $f -value $f -variable expgui(font) -font "Helvetica -$f"
4111	}
4112
4113	$expgui(fm).option.menu add checkbutton -label "Show EXPTOOL output" \
4114	-variable expgui(showexptool)
4115	$expgui(fm).option.menu add command -label "Save Options" \
4116	-command "SaveOptions"
4117
4118	pack $expgui(fm).file $expgui(fm).option -side left -in $expgui(fm)
4119
4120	if {$expgui(shell)} {
4121	foreach menu $expgui(menunames) {
4122	set m [string tolower $menu]
4123	pack [menubutton $expgui(fm).$m -text $menu \
4124	-menu $expgui(fm).$m.menu] -side left
4125	menu $expgui(fm).$m.menu
4126	}
4127	}
4128	pack $expgui(fm).help -side right -in $expgui(fm)
4129
4130	if {$expgui(shell)} {
4131	# add an export command to the last menu that gets filled in later
4132	$expgui(fm).$m.menu add cascade -label "Coord Export" \
4133	-menu $expgui(fm).$m.menu.coordexp
4134	menu $expgui(fm).$m.menu.coordexp \
4135	-postcommand "BuildCoordExpMenu $expgui(fm).$m.menu.coordexp"
4136	$expgui(fm).$m.menu.coordexp add command -label "Building menu" \
4137	-state disabled
4138	$expgui(fm).$m.menu.coordexp add command -label "Please wait..." \
4139	-state disabled
4140
4141	$expgui(fm).$m.menu add cascade -label "CIF Export" \
4142	-menu $expgui(fm).$m.menu.cifexp
4143	menu $expgui(fm).$m.menu.cifexp
4144	$expgui(fm).$m.menu.cifexp add command -label gsas2cif \
4145	-command "runGSASwEXP gsas2cif"
4146	$expgui(fm).$m.menu.cifexp add command -label FillTemplate \
4147	-command "exec $wishshell [file join $expgui(scriptdir) fillcif.tcl] \[file root \[file tail \$expgui(expfile)]]"
4148	$expgui(fm).$m.menu.cifexp add command -label CIFselect \
4149	-command {
4150	if {[info procs CIFselect] == ""} {
4151	source [file join $expgui(scriptdir) cifselect.tcl]
4152	}
4153	CIFselect $expgui(expfile)
4154	}
4155	# add the commands in expgui_menulist
4156	foreach menu [array names expgui_menulist ] {
4157	foreach cmd $expgui_menulist($menu) {
4158	set action {}
4159	set opt {}
4160	catch {set action [lindex $expgui_cmdlist($cmd) 0]}
4161	catch {set opt [lindex $expgui_cmdlist($cmd) 2]}
4162	if {$expgui(debug) && $action == ""} {puts "blank command for $cmd"}
4163	if {$action != "" && $action != "-"} {
4164	eval $expgui(fm).$menu.menu add command \
4165	-label $cmd $opt -command [list [subst $action]]
4166	if {[lindex $opt 0] == "-underline"} {
4167	catch {
4168	set num [lindex $opt 1]
4169	set key [string range $cmd $num $num]
4170	bind . <Alt-[string tolower $key]> [subst $action]
4171	bind . <Alt-[string toupper $key]> [subst $action]
4172	}
4173	}
4174	}
4175	}
4176	}
4177	}
4178	# setup command help
4179	foreach cmd [array names expgui_cmdlist] {
4180	set help {}
4181	catch {set help [lindex $expgui_cmdlist($cmd) 1]}
4182	if {$help == ""} {
4183	if {$expgui(debug)} {puts "no help for $cmd"}
4184	} else {
4185	# remove
4186	regsub -all \x09 $help " " help
4187	# preserve blank lines
4188	regsub -all \x0A\x0A $help "AAA1234567890AAA" help
4189	regsub -all \x0A $help " " help
4190	regsub -all "AAA1234567890AAA" $help \x0A\x0A help
4191	regsub -all " +" $help " " help
4192	set expgui_helplist($cmd) [string trim $help]
4193	}
4194	}
4195	if {$expgui(shell)} {
4196	# set up button bar
4197	foreach cmd $expgui(buttonlist) {
4198	set action {}
4199	catch {set action [lindex $expgui_cmdlist($cmd) 0]}
4200	if {$expgui(debug) && $action == ""} {puts "blank command for $cmd"}
4201	if {$action != ""} {
4202	pack [eval button .bar.$cmd -bg beige -activebackground yellow \
4203	-padx 2m -pady 0 \
4204	-text $cmd -command [list [subst $action]]] -side left
4205	}
4206	}
4207	}
4208
4209	$expgui(fm).file.menu add command -label "Exit" -underline 1 -command catchQuit
4210	foreach c {X x} {bind . <Alt-$c> [list catchQuit]}
4211	#^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ END OF MENU DEFINITION ^^^^^^^^^^^^^^^^^^^
4212
4213	# make the phase pane -- this must be done before setphases
4214	# can be called (in loadexp)
4215	MakePhasePane
4216	# and the rest of the windows w/o BWidget
4217	if {!$expgui(haveBW)} {
4218	MakeHistPane
4219	MakeScalingPane
4220	MakeProfilePane
4221	}
4222
4223	# handle indirect exits
4224	wm protocol . WM_DELETE_WINDOW catchQuit
4225	bind . <Control-c> catchQuit
4226
4227	set expgui(pagenow) ""
4228	set expgui(curhist) {}
4229	set expgui(selectedatomlist) {}
4230
4231	loadexp $expgui(expfile)
4232
4233	# reset the phase selection
4234	set expgui(curPhase) {}
4235	# select the first histogram in the list by default (if there are any)
4236	if {[llength $expmap(histlistboxcontents)] > 0} {
4237	set expgui(curhist) 0
4238	} else {
4239	set expgui(curhist) {}
4240	}
4241
4242	# execute any local commands for final initialization
4243	eval $expgui(initstring)
4244
4245	# resize the notebook to fit all the tabs and the largest page
4246	ResizeNotebook
4247
4248	RaisePage lsFrame
4249	if {[CountHistory] > 100} {
4250	DeleteHistoryRecords "This .EXP file has [CountHistory] history records\nErasing most will speed EXPGUI"
4251	}

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

Download in other formats: