Context Navigation

source: trunk/expgui @ 305

Last change on this file since 305 was 303, checked in by toby, 13 years ago
# on 2000/10/03 23:29:29, toby did: Add definitions and implementation for entrybox array so that invalid numbers are set to red. Valid ones, or when numbers are reread from the .EXP are turned back to black
Property rcs:author set to `toby` Property rcs:date set to `2000/10/03 23:29:29` Property rcs:lines set to `+69 -58` Property rcs:rev set to `1.35` Property rcs:state set to `Exp` Property svn:keywords set to `Author Date Revision Id`
File size: 117.3 KB

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

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

Download in other formats:

Original Format