Context Navigation

source: trunk/addcmds.tcl @ 920

Last change on this file since 920 was 920, checked in by toby, 14 years ago
# on 2008/06/30 23:51:43, toby did: fix bug on ImportPhase? with 1 format (e.g. .cif on Windows)
Property rcs:author set to `toby` Property rcs:date set to `2008/06/30 23:51:43` Property rcs:lines set to `+2 -2` Property rcs:rev set to `1.42` Property rcs:state set to `Exp` Property svn:keywords set to `Author Date Revision Id`
File size: 81.8 KB

Line
1	# $Id: addcmds.tcl 920 2009-12-04 23:14:20Z toby $
2
3	#----------- Add Phase routines ----------------------------------------
4
5	proc MakeAddPhaseBox {} {
6	global expmap expgui
7
8	set expgui(coordList) {}
9	set nextphase ""
10	foreach p {1 2 3 4 5 6 7 8 9} {
11	if {[lsearch $expmap(phaselist) $p] == -1} {
12	set nextphase $p
13	break
14	}
15	}
16
17	# no more room
18	if {$nextphase == ""} {
19	MyMessageBox -parent . -title "Add Phase Error" \
20	-message "There are already 9 phases. You cannot add more." \
21	-icon error
22	return
23	}
24
25	set np .newphase
26	catch {destroy $np}
27	toplevel $np
28	bind $np <Key-F1> "MakeWWWHelp expgui2.html addphase"
29
30	grid [label $np.l1 -text "Adding phase #$nextphase"] \
31	-column 0 -row 0 -sticky w
32	grid [label $np.l2 -text "Phase title:"] -column 0 -row 1
33	grid [entry $np.t1 -width 68] -column 1 -row 1 -columnspan 8
34	grid [label $np.l3 -text "Space Group:"] -column 0 -row 2
35	grid [entry $np.t2 -width 12] -column 1 -row 2
36	grid [frame $np.ct -bd 2 -relief groove] -column 3 -row 2
37	grid [frame $np.f -bd 4 -relief groove] -column 4 -row 2 -columnspan 8
38	grid [label $np.ct.l -text "Cell\nType"] -column 0 -row 2
39	set menu [tk_optionMenu $np.ct.s expgui(addPhaseCellType) ""]
40	$menu delete 0
41	foreach val {Any Cubic Tetragonal Hexagonal Rhombohedral Orthorhombic Monoclinic} \
42	lbl {Any Cubic Tetrag Hexag Rhomb. Ortho Mono} {
43	$menu add radiobutton -value $lbl -label $val \
44	-command "set expgui(addPhaseCellType) $lbl"
45	}
46	grid $np.ct.s
47	foreach v [ trace vinfo expgui(addPhaseCellType)] {
48	eval trace vdelete expgui(addPhaseCellType) $v
49	}
50	#set expgui(addPhaseCellType) Any
51	$menu invoke 0
52	trace variable expgui(addPhaseCellType) w "SetAddCellSymConstr $np.f"
53
54	set col -1
55	foreach i {a b c} {
56	grid [label $np.f.l1$i -text " $i "] -column [incr col] -row 1
57	grid [entry $np.f.e1$i -width 12] -column [incr col] -row 1
58	}
59	set col -1
60	foreach i {a b g} {
61	grid [label $np.f.l2$i -text $i] -column [incr col] -row 2
62	set font [$np.f.l2$i cget -font]
63	$np.f.l2$i config -font "Symbol [lrange $font 1 end]"
64	grid [entry $np.f.e2$i -width 12] -column [incr col] -row 2
65	$np.f.e2$i insert 0 90.
66	}
67
68	grid [frame $np.bf] -row 3 -column 0 -columnspan 10 -sticky ew
69	grid [button $np.bf.b1 -text Add \
70	-command "addphase $np"] -column 2 -row 3
71	bind $np <Return> "addphase $np"
72	grid [button $np.bf.b2 -text Cancel \
73	-command "destroy $np"] -column 3 -row 3
74	grid columnconfig $np.bf 4 -weight 1
75	grid [button $np.bf.help -text Help -bg yellow \
76	-command "MakeWWWHelp expgui2.html addphase"] \
77	-column 4 -row 3
78
79	# get the input formats if not already defined
80	GetImportFormats
81	if {[llength $expgui(importFormatList)] > 0} {
82	grid [frame $np.bf.fr -bd 4 -relief groove] -column 5 -row 3
83	grid [button $np.bf.fr.b3 -text "Import phase from: " \
84	-command "ImportPhase \$expgui(importFormat) $np"] \
85	-column 0 -row 0 -sticky e
86	set menu [eval tk_optionMenu $np.bf.fr.b4 expgui(importFormat) \
87	$expgui(importFormatList)]
88	for {set i 0} {$i <= [$menu index end]} {incr i} {
89	$menu entryconfig $i -command "ImportPhase \$expgui(importFormat) $np"
90	}
91	grid $np.bf.fr.b4 -column 1 -row 0 -sticky w
92	grid rowconfig $np.bf.fr 0 -pad 10
93	grid columnconfig $np.bf.fr 0 -pad 10
94	grid columnconfig $np.bf.fr 1 -pad 10
95	}
96	wm title $np "add new phase"
97
98	# set grab, etc.
99	putontop $np
100
101	tkwait window $np
102
103	# fix grab...
104	afterputontop
105	}
106	proc SetAddCellSymConstr {box args} {
107	switch $::expgui(addPhaseCellType) {
108	Any {
109	foreach i {a b c} {
110	$box.e1$i configure -textvariable "" -state normal
111	}
112	foreach i {a b g} {
113	$box.e2$i configure -textvariable "" -state normal
114	}
115	}
116	Cubic {
117	set ::expgui(AddCella) [$box.e1a get]
118	foreach i {a b c} {
119	$box.e1$i configure -textvariable expgui(AddCella) -state normal
120	}
121	foreach i {a b g} {
122	$box.e2$i configure -textvariable "" -state normal
123	$box.e2$i delete 0 end
124	$box.e2$i insert 0 90.
125	$box.e2$i configure -textvariable "" -state disabled
126	}
127	}
128	Tetrag {
129	set ::expgui(AddCella) [$box.e1a get]
130	foreach i {a b} {
131	$box.e1$i configure -textvariable expgui(AddCella) -state normal
132	}
133	$box.e1c configure -textvariable "" -state normal
134	foreach i {a b g} {
135	$box.e2$i configure -textvariable "" -state normal
136	$box.e2$i delete 0 end
137	$box.e2$i insert 0 90.
138	$box.e2$i configure -textvariable "" -state disabled
139	}
140	}
141	Hexag {
142	set ::expgui(AddCella) [$box.e1a get]
143	foreach i {a b} {
144	$box.e1$i configure -textvariable expgui(AddCella) -state normal
145	}
146	$box.e1c configure -textvariable "" -state normal
147	foreach i {a b g} {
148	$box.e2$i configure -textvariable "" -state normal
149	$box.e2$i delete 0 end
150	if {$i == "g"} {
151	$box.e2$i insert 0 120.
152	} else {
153	$box.e2$i insert 0 90.
154	}
155	$box.e2$i configure -textvariable "" -state disabled
156	}
157	}
158	Rhomb. {
159	set ::expgui(AddCella) [$box.e1a get]
160	foreach i {a b c} {
161	$box.e1$i configure -textvariable expgui(AddCella) -state normal
162	}
163	set ::expgui(AddCellalpha) [$box.e2a get]
164	foreach i {a b g} {
165	$box.e2$i configure -textvariable expgui(AddCellalpha) -state normal
166	}
167	}
168	Ortho {
169	foreach i {a b c} {
170	$box.e1$i configure -textvariable "" -state normal
171	}
172	foreach i {a b g} {
173	$box.e2$i configure -textvariable "" -state normal
174	$box.e2$i delete 0 end
175	$box.e2$i insert 0 90.
176	$box.e2$i configure -textvariable "" -state disabled
177	}
178	}
179	Mono {
180	foreach i {a b c} {
181	$box.e1$i configure -textvariable "" -state normal
182	}
183	foreach i {a g} {
184	$box.e2$i configure -textvariable "" -state normal
185	$box.e2$i delete 0 end
186	$box.e2$i insert 0 90.
187	$box.e2$i configure -textvariable "" -state disabled
188	}
189	$box.e2b configure -textvariable "" -state normal
190	}
191	}
192	}
193
194
195	proc addphase {np} {
196	global expgui expmap
197	# validate the input
198	set err {}
199	set title [$np.t1 get]
200	if {[string trim $title] == ""} {
201	append err " Title cannot be blank\n"
202	}
203	set spg [$np.t2 get]
204	if {[string trim $spg] == ""} {
205	append err " Space group cannot be blank\n"
206	}
207	foreach i {a b c} {
208	set cell($i) [$np.f.e1$i get]
209	if {[string trim $cell($i)] == ""} {
210	append err " $i cannot be blank\n"
211	} elseif {[catch {expr $cell($i)}]} {
212	append err " $i is not valid\n"
213	}
214	}
215
216	foreach i {a b g} lbl {alpha beta gamma} {
217	set cell($lbl) [$np.f.e2$i get]
218	if {[string trim $cell($lbl)] == ""} {
219	append err " $lbl cannot be blank\n"
220	} elseif {[catch {expr $cell($lbl)}]} {
221	append err " $lbl is not valid\n"
222	}
223	}
224
225	if {$expgui(addPhaseCellType) == "Rhomb."} {
226	# check for proper use of space group in Rhomb. setting
227	if {[string toupper [string range [string trim $spg] 0 0]] != "R"} {
228	append err "Rhombohedral cell specified, but space group does not start with R\n"
229	}
230	if {[string toupper [string range [string trim $spg] end end]] != "R"} {
231	append spg " R"
232	if {$err == ""} {
233	# no need to warn on error
234	MyMessageBox -parent $np -title "Space Group Fix" \
235	-message "Adding a final 'R' to the space group for rhombohedral space group set in rhombohedral cell, as required in GSAS" \
236	-icon warning
237	}
238	}
239	}
240	if {$err != ""} {
241	MyMessageBox -parent . -title "Add Phase Error" \
242	-message "The following error(s) were found in your input:\n$err" \
243	-icon error
244	set expgui(oldphaselist) -1
245	return
246	}
247
248	# check the space group
249	set fp [open spg.in w]
250	puts $fp "N"
251	puts $fp "N"
252	puts $fp $spg
253	puts $fp "Q"
254	close $fp
255	global tcl_platform
256	catch {
257	if {$tcl_platform(platform) == "windows"} {
258	exec [file join $expgui(gsasexe) spcgroup.exe] < spg.in >& spg.out
259	} else {
260	exec [file join $expgui(gsasexe) spcgroup] < spg.in >& spg.out
261	}
262	}
263	set fp [open spg.out r]
264	set out [read $fp]
265	close $fp
266	# attempt to parse out the output (fix up if parse did not work)
267	if {[regexp "space group symbol.>(.)Enter a new space group symbol" \
268	$out a b ] != 1} {set b $out}
269	if {[string first Error $b] != -1} {
270	# got an error, show it
271	ShowBigMessage \
272	$np.error \
273	"Error processing space group\nReview error message below" \
274	$b OK "" 1
275	set expgui(oldphaselist) -1
276	return
277	} else {
278	# show the result and confirm
279	set opt [ShowBigMessage \
280	$np.check \
281	"Check the symmetry operators in the output below" \
282	$b \
283	{Continue Redo} ]
284	if {$opt > 1} {
285	set expgui(oldphaselist) -1
286	return
287	}
288	}
289	file delete spg.in spg.out
290	# ok do it!
291	set errmsg [runAddPhase $title $spg \
292	$cell(a) $cell(b) $cell(c) \
293	$cell(alpha) $cell(beta) $cell(gamma)]
294	RecordMacroEntry "runAddPhase [list $title] [list $spg] \
295	$cell(a) $cell(b) $cell(c) \
296	$cell(alpha) $cell(beta) $cell(gamma)" 0
297	destroy $np
298	if {$expgui(showexptool) \|\| $errmsg != ""} {
299	if {$errmsg != ""} {
300	set err 1
301	append errmsg "\n" $expgui(exptoolout)
302	} else {
303	set err 0
304	set errmsg $expgui(exptoolout)
305	}
306	set msg "Please review the result from adding the phase"
307	if { $errmsg != ""} {append msg "\nIt appears an error occurred!"}
308	ShowBigMessage $np $msg $errmsg OK "" $err
309	}
310	# set the powpref warning (2 = required)
311	set expgui(needpowpref) 2
312	set msg "A phase was added"
313	if {[string first $msg $expgui(needpowpref_why)] == -1} {
314	append expgui(needpowpref_why) "\t$msg\n"
315	}
316	# now select the new phase
317	SelectOnePhase [lindex $expmap(phaselist) end]
318	}
319
320	proc runAddPhase {title spg a b c alpha beta gamma} {
321	global expgui expmap tcl_platform
322	set fp [open exptool.in w]
323	puts $fp "P"
324	puts $fp $title
325	puts $fp $spg
326	puts $fp "$a $b $c $alpha $beta $gamma"
327	puts $fp "/"
328	close $fp
329	# Save the current exp file
330	savearchiveexp
331	# disable the file changed monitor
332	set expgui(expModifiedLast) 0
333	set expnam [file root [file tail $expgui(expfile)]]
334	# save the previous phase list
335	set expgui(oldphaselist) $expmap(phaselist)
336	set err [catch {
337	if {$tcl_platform(platform) == "windows"} {
338	exec [file join $expgui(gsasexe) exptool.exe] $expnam \
339	< exptool.in >& exptool.out
340	} else {
341	exec [file join $expgui(gsasexe) exptool] $expnam \
342	< exptool.in >& exptool.out
343	}
344	} errmsg]
345	# load the revised exp file
346	set oldphaselist $expmap(phaselist)
347	loadexp $expgui(expfile)
348	set fp [open exptool.out r]
349	set expgui(exptoolout) [read $fp]
350	close $fp
351	catch {file delete exptool.in exptool.out}
352
353	if {[llength $oldphaselist] == [llength $expmap(phaselist)]} {
354	set err 1
355	if {$errmsg == ""} {set errmsg "No phase added"}
356	}
357	if {$err} {
358	return $errmsg
359	} else {
360	return ""
361	}
362	}
363
364
365	#----------- Add Histogram routines --------------------------------------
366	proc LabelInstParm {args} {
367	global newhist
368	switch $newhist(insttype) {
369	TOF {
370	set newhist(instfiletext) "Neutron Time of Flight"
371	catch {
372	set b $newhist(setnum)
373	append newhist(instfiletext) ", 2theta = $newhist(inst${b}Angle)"
374	}
375	}
376	ED {set newhist(instfiletext) "X-ray Energy Dispersive"}
377	"CW X" {set newhist(instfiletext) "CW X-ray"}
378	"CW N" {set newhist(instfiletext) "CW Neutron"}
379	}
380	}
381	trace variable newhist(setnum) w LabelInstParm
382	trace variable newhist(LimitMode) w ClearHistLimit
383	set newhist(LimitMode_boxes) {}
384
385	proc ClearHistLimit {args} {
386	global newhist
387	if {$newhist(LimitMode) == 1} {return}
388	foreach box $newhist(LimitMode_boxes) {
389	catch {$box delete 0 end}
390	}
391	}
392
393	proc MakeAddHistBox {} {
394	global expmap newhist
395
396	# --> should check here if room for another histogram, but only texture
397	# folks will ever need that
398
399	set np .newhist
400	catch {destroy $np}
401	toplevel $np
402	bind $np <Key-F1> "MakeWWWHelp expgui3.html AddHist"
403
404	grid [label $np.l0 -text "Adding a new histogram"] \
405	-column 0 -row 0 -sticky ew -columnspan 7
406	grid [checkbutton $np.d0 -text "Dummy Histogram" -variable newhist(dummy) \
407	-command "PostDummyOpts $np" \
408	] -column 2 -row 0 -columnspan 99 -sticky e
409	grid [label $np.l1 -text "Data file:"] -column 0 -row 2
410	grid [label $np.t1 -textvariable newhist(rawfile) -bd 2 -relief ridge] \
411	-column 1 -row 2 -columnspan 3 -sticky ew
412	grid [button $np.b1 -text "Select File" \
413	-command "getrawfile $np" \
414	] -column 4 -row 2
415
416	grid [label $np.lbank -text "Select bank" -anchor w] -column 1 -row 3 -sticky w
417	grid [frame $np.bank] -column 2 -row 3 -columnspan 7 -sticky ew
418
419	grid [label $np.l2 -text "Instrument\nParameter file:"] -column 0 -row 5
420	grid [label $np.t2 -textvariable newhist(instfile) -bd 2 -relief ridge] \
421	-column 1 -row 5 -columnspan 3 -sticky ew
422	grid [button $np.b2 -text "Select File" \
423	-command "getinstfile $np" \
424	] -column 4 -row 5
425	grid [button $np.edit -text "Edit file" \
426	-command {EditInstFile $newhist(instfile)}] \
427	-column 5 -row 5
428
429	grid [label $np.lset -text "Select set" -anchor w] -column 1 -row 6 -sticky w
430	grid [frame $np.set] -column 2 -row 6 -columnspan 7 -sticky ew
431	grid [label $np.t2a -textvariable newhist(instfiletext) \
432	-justify center -anchor center -fg blue] \
433	-column 0 -row 8 -columnspan 99 -sticky ew
434
435	grid [button $np.f6a -text "Run\nRAWPLOT" -command "RunRawplot $np"] \
436	-column 4 -row 18 -rowspan 2
437	grid [label $np.l3 -text "Usable data limit:"] -column 0 -row 18 -rowspan 3
438	grid [entry $np.e3 -width 12 -textvariable newhist(2tLimit) \
439	] -column 1 -row 18 -rowspan 3
440	grid [radiobutton $np.cb3 -text "d-min" -variable newhist(LimitMode) \
441	-value 0] -column 2 -row 18 -sticky w
442	grid [radiobutton $np.cb4 -textvariable newhist(limitLbl) \
443	-variable newhist(LimitMode) -anchor w -justify l \
444	-value 1] -column 2 -row 20 -sticky w
445	set newhist(LimitMode_boxes) $np.e3
446	grid [radiobutton $np.cb5 -text "Q-max" -variable newhist(LimitMode) \
447	-value 2] -column 2 -row 19 -sticky w
448	set newhist(limitLbl) "TOF-min\n2-Theta Max"
449	# spacers
450	grid [frame $np.sp0 -bg white] \
451	-columnspan 20 -column 0 -row 1 -sticky nsew -ipady 2
452	grid [frame $np.sp1 -bg white] \
453	-columnspan 20 -column 0 -row 4 -sticky nsew -ipady 2
454	grid [frame $np.sp2 -bg white] \
455	-columnspan 20 -column 0 -row 17 -sticky nsew -ipady 2
456	grid [frame $np.sp3 -bg white] \
457	-columnspan 20 -column 0 -row 98 -sticky nsew -ipady 2
458	grid [frame $np.f6] -column 0 -row 99 -columnspan 5 -sticky ew
459	grid [button $np.f6.b6a -text Add \
460	-command "addhist $np"] -column 0 -row 0
461	bind $np <Return> "addhist $np"
462	grid [button $np.f6.b6b -text Cancel \
463	-command "destroy $np"] -column 1 -row 0
464	grid [button $np.f6.b6c -text "Add multiple banks" \
465	-command "addMultiplehist $np" -state disabled] -column 2 -row 0
466	grid [button $np.f6.help -text Help -bg yellow \
467	-command "MakeWWWHelp expgui3.html AddHist"] \
468	-column 2 -row 0 -sticky e
469	grid columnconfigure $np.f6 2 -weight 1
470	grid columnconfigure $np 3 -weight 1
471
472	# dummy histogram stuff
473	frame $np.d1
474	grid [label $np.d1.l1 -text min] -column 1 -row 1
475	grid [label $np.d1.l2 -text max] -column 2 -row 1
476	grid [label $np.d1.l3 -text step] -column 3 -row 1
477	grid [label $np.d1.lu -text ""] -column 4 -row 1 -rowspan 2
478	grid [entry $np.d1.e1 -width 10 -textvariable newhist(tmin)] -column 1 -row 2
479	grid [entry $np.d1.e2 -width 10 -textvariable newhist(tmax)] -column 2 -row 2
480	grid [entry $np.d1.e3 -width 10 -textvariable newhist(tstep)] -column 3 -row 2
481	grid [label $np.d1.m1 -anchor w] -column 1 -row 3 -sticky ew
482	grid [label $np.d1.m2 -anchor w] -column 2 -row 3 -sticky ew
483	label $np.dl1 -text "Data range:"
484	label $np.dl2 -text "Allowed"
485	label $np.dl3 -text "\n" -justify left -fg blue
486	wm title $np "add new histogram"
487
488	set newhist(banknum) {}
489	set newhist(setnum) {}
490	if {[string trim $newhist(rawfile)] != {}} {
491	validaterawfile $np $newhist(rawfile)
492	}
493	if {[string trim $newhist(instfile)] != {}} {
494	validateinstfile $np $newhist(instfile)
495	}
496
497	PostDummyOpts $np
498	# set grab, etc.
499	putontop $np
500
501	tkwait window $np
502
503	# fix grab...
504	afterputontop
505	}
506
507	# convert a file to Win-95 direct access
508	proc WinCvt {file win} {
509	global expgui
510	if ![file exists $file] {
511	MyMessageBox -parent $win -title "Convert Error" \
512	-message "File $file does not exist" -icon error
513	return
514	}
515
516	set tmpname "[file join [file dirname $file] tempfile.xxx]"
517	set oldname "[file rootname $file].org"
518	if [file exists $oldname] {
519	set ans [MyMessageBox -parent $win -title "OK to overwrite?" \
520	-message "File [file tail $oldname] exists in [file dirname $oldname]. OK to overwrite?" \
521	-icon question -type yesno -default yes]
522	if {$ans == "no"} return
523	catch {file delete $oldname}
524	}
525
526	if [catch {
527	set in [open $file r]
528	# needed to test under UNIX
529	set out [open $tmpname w]
530	fconfigure $out -translation crlf
531	set len [gets $in line]
532	if {$len > 160} {
533	# this is an old-style UNIX file. Hope there are no control characters
534	set i 0
535	set j 79
536	while {$j < $len} {
537	puts $out [string range $line $i $j]
538	incr i 80
539	incr j 80
540	}
541	} else {
542	while {$len >= 0} {
543	append line " "
544	append line " "
545	set line [string range $line 0 79]
546	puts $out $line
547	set len [gets $in line]
548	}
549	}
550	close $in
551	close $out
552	file rename $file $oldname
553	file rename $tmpname $file
554	} errmsg] {
555	MyMessageBox -parent $win -title Notify \
556	-message "Error in conversion:\n$errmsg" -icon warning
557	}
558	return $file
559	}
560
561	proc getrawfile {np} {
562	global newhist tcl_platform
563	if {$tcl_platform(platform) == "windows"} {
564	set inp [
565	tk_getOpenFile -parent $np -initialfile $newhist(rawfile) -filetypes {
566	{"Data files" .GSAS} {"Data files" .GSA}
567	{"Data files" .RAW} {"Data files" .FXYE} {"All files" *}
568	}
569	]
570	} else {
571	set inp [
572	tk_getOpenFile -parent $np -initialfile $newhist(rawfile) -filetypes {
573	{"Data files" .GSA*} {"Data files" .RAW}
574	{"Data files" .gsa*} {"Data files" .raw} {"Data files" .fxye}
575	{"All files" *}
576	}
577	]
578	}
579	validaterawfile $np $inp
580	}
581
582	proc validaterawfile {np inp} {
583	global expgui newhist
584	if {$inp == ""} return
585	if [catch {set in [open $inp r]}] {
586	MyMessageBox -parent $np -title "Open error" \
587	-message "Unable to open file $inp" -icon error
588	return
589	}
590	set newhist(banklist) {}
591	foreach child [winfo children $np.bank] {destroy $child}
592	# is this a properly formatted file?
593	# -- are lines the correct length & terminated with a CR-LF?
594	fconfigure $in -translation lf
595	set i 0
596	while {[set len [gets $in line]] > 0} {
597	incr i
598	#if {$len != 81 \|\| [string range $line end end] != "\r"} {
599	# set ans [MyMessageBox -parent $np -title "Convert?" \
600	# -message "File $inp is not in the correct format for GSAS.\nOK to convert?" \
601	# -icon warning -type {OK Quit} -default OK]
602	# if {$ans == "ok"} {
603	# # convert and reopen the file
604	# close $in
605	# WinCvt $inp $np
606	# set i 0
607	# set in [open $inp r]
608	# fconfigure $in -translation lf
609	# set line {}
610	# } else {
611	# return
612	# }
613	#}
614	# scan for BANK lines
615	if {[string first BANK $line] == 0} {
616	scan $line "BANK%d" num
617	lappend newhist(banklist) $num
618	# compute last point
619	set tmin 0
620	set tmax 0
621	catch {
622	scan $line "BANK%d%d%d%s%f%f" num nchan nrec rest start step
623	set tmin [expr $start/100.]
624	set tmax [expr ($start + $step*($nchan-1))/100.]
625	}
626	set newhist(tmin$num) $tmin
627	set newhist(tmax$num) $tmax
628	}
629	# check for "Instrument parameter file" line
630	if {$i == 2 && [string first "Instrument parameter" $line] == 0} {
631	validateinstfile $np \
632	[file join [file dirname $inp] \
633	[string trim [string range $line 26 end]]]
634	}
635	}
636	# were banks found?
637	if {$newhist(banklist) == ""} {
638	MyMessageBox -parent $np -title "Read error" \
639	-message "File $inp has no BANK lines.\nThis is not a valid GSAS data file." \
640	-icon warning
641	return
642	}
643	# don't use a full path unless needed
644	if {[pwd] == [file dirname $inp]} {
645	set newhist(rawfile) [file tail $inp]
646	} else {
647	set newhist(rawfile) $inp
648	}
649	set row 0
650	set col -1
651	set flag 0
652	foreach i $newhist(banklist) {
653	if {$col > 8} {
654	set col -1
655	incr row
656	}
657	grid [radiobutton $np.bank.$i -text $i -command SetTmax \
658	-variable newhist(banknum) -value $i] \
659	-column [incr col] -row $row -sticky w
660	# only 1 choice, so set it
661	if {[llength $newhist(banklist)] == 1} {
662	set newhist(banknum) $i
663	SetTmax
664	} else {
665	set flag 1
666	}
667	}
668	if {$flag} {
669	set newhist(2tLimit) {}
670	set newhist(LimitMode) {}
671	}
672	SetMultipleAdd $np
673	}
674
675	proc SetTmax {} {
676	global newhist
677	set num $newhist(banknum)
678	if {$newhist(insttype) == "TOF"} {
679	set newhist(2tLimit) [expr {$newhist(tmin$num) / 10.}]
680	if {[llength $newhist(banklist)] == $newhist(instbanks)} {
681	set newhist(setnum) $newhist(banknum)
682	}
683	} else {
684	set newhist(2tLimit) $newhist(tmax$num)
685	}
686	set newhist(LimitMode) 1
687
688	}
689
690	proc getinstfile {np} {
691	global newhist tcl_platform
692	if {$tcl_platform(platform) == "windows"} {
693	set inp [
694	tk_getOpenFile -parent $np -initialfile $newhist(instfile) -filetypes {
695	{"Inst files" .INST} {"Inst files" .INS}
696	{"Inst files" .PRM} {"All files" *}
697	}
698	]
699	} else {
700	set inp [
701	tk_getOpenFile -parent $np -initialfile $newhist(instfile) -filetypes {
702	{"Inst files" .INS} {"Inst files" .ins}
703	{"Inst files" .PRM} {"Inst files" .prm}
704	{"All files" *}
705	}
706	]
707	}
708	set newhist(setnum) {}
709	validateinstfile $np $inp
710	}
711
712	proc validateinstfile {np inp} {
713	global expgui newhist
714	if {$inp == ""} return
715	if [catch {set in [open $inp r]}] {
716	MyMessageBox -parent $np -title "Open error" \
717	-message "Unable to open file $inp" -icon error
718	return
719	}
720	set newhist(instbanks) {}
721	foreach child [winfo children $np.set] {destroy $child}
722	# is this a properly formatted file?
723	# -- are lines the correct length & terminated with a CR-LF?
724	fconfigure $in -translation lf
725	while {[set len [gets $in line]] >= 0} {
726	if {$len != 81 \|\| [string range $line end end] != "\r"} {
727	set ans [MyMessageBox -parent $np -title "Convert?" \
728	-message "File $inp is not in the correct format for GSAS.\nOK to convert?" \
729	-icon warning -type {OK Quit} -default OK]
730	if {$ans == "ok"} {
731	# convert and reopen the file
732	close $in
733	WinCvt $inp $np
734	set in [open $inp r]
735	fconfigure $in -translation lf
736	set line {}
737	} else {
738	return
739	}
740	}
741	# scan for the INS BANK line
742	if {[string first "INS BANK" $line] == 0} {
743	set newhist(instbanks) \
744	[string trim [string range $line 12 end]]
745	}
746	# scan for the INS HTYPE line
747	if {[string first "INS HTYPE" $line] == 0} {
748	if {[string index [lindex $line 2] 2] == "T"} {
749	set newhist(insttype) TOF
750	} elseif {[string index [lindex $line 2] 2] == "E"} {
751	set newhist(insttype) ED
752	} elseif {[string index [lindex $line 2] 1] == "X"} {
753	set newhist(insttype) "CW X"
754	} else {
755	set newhist(insttype) "CW N"
756	}
757	}
758	# scan for the instrument constants
759	if {[regexp {INS ([ 1-9][0-9]) ICONS(.*)} $line a b c]} {
760	set b [string trim $b]
761	set newhist(inst${b}ICONS) [string trim $c]
762	}
763	if {[regexp {INS ([ 1-9][0-9])I ITYP(.*)} $line a b c]} {
764	set b [string trim $b]
765	set newhist(inst${b}ITYP) [string trim $c]
766	}
767	if {[regexp {INS ([ 1-9][0-9])BNKPAR(.*)} $line a b c]} {
768	set b [string trim $b]
769	set newhist(inst${b}Angle) [string trim [lindex $c 1]]
770	}
771	}
772	# were banks found?
773	if {$newhist(instbanks) == ""} {
774	MyMessageBox -parent $np -title "Read error" -message \
775	"File $inp has no \"INS BANK\" line.\nThis is not a valid GSAS Instrument Parameter file." \
776	-icon warning
777	return
778	}
779	# don't use a full path unless needed
780	if {[pwd] == [file dirname $inp]} {
781	set newhist(instfile) [file tail $inp]
782	} else {
783	set newhist(instfile) $inp
784	}
785	set col -1
786	set row 0
787	for {set i 1} {$i <= $newhist(instbanks)} {incr i} {
788	if {$col > 8} {
789	set col -1
790	incr row
791	}
792	grid [radiobutton $np.set.$i -text $i \
793	-command "PostDummyOpts $np; ValidateDummyHist $np" \
794	-variable newhist(setnum) -value $i] \
795	-column [incr col] -row $row -sticky w
796	if {$newhist(instbanks) == 1} {set newhist(setnum) $i}
797	}
798	if {$newhist(dummy)} {PostDummyOpts $np; ValidateDummyHist $np}
799	LabelInstParm
800	SetMultipleAdd $np
801	}
802
803	proc addhist {np} {
804	global expgui newhist tcl_platform expmap
805	if {$newhist(dummy)} {
806	AddDummyHist $np
807	return
808	}
809	# validate the input
810	set err {}
811	if {[string trim $newhist(rawfile)] == ""} {
812	append err " No data file specified\n"
813	}
814	if {[string trim $newhist(instfile)] == ""} {
815	append err " No instrument parameter file specified\n"
816	}
817	if {[string trim $newhist(banknum)] == ""} {
818	append err " Bank number must be specified\n"
819	} elseif {[catch {expr $newhist(banknum)}]} {
820	append err " Bank number is not valid\n"
821	}
822	if {[string trim $newhist(setnum)] == ""} {
823	append err " Parameter set number must be specified\n"
824	} elseif {[catch {expr $newhist(setnum)}]} {
825	append err " Parameter set number is not valid\n"
826	}
827	if {[string trim $newhist(2tLimit)] == ""} {
828	append err " 2Theta/d-space limit must be specified\n"
829	} elseif {[catch {expr $newhist(2tLimit)}]} {
830	append err " The 2Theta/d-space limit is not valid\n"
831	} elseif {$newhist(2tLimit) <= 0} {
832	append err " The 2Theta/d-space limit is not valid\n"
833	}
834	if {[string trim $newhist(LimitMode)] == ""} {
835	append err " Please choose between either a 2Theta, Q or d-space limit\n"
836	}
837
838	if {$err != ""} {
839	MyMessageBox -parent $np -title "Add Histogram Error" \
840	-message "The following error(s) were found in your input:\n$err" \
841	-icon error -type ok -default ok \
842	-helplink "expgui3.html AddHistErr"
843	return
844	}
845
846	if {$newhist(LimitMode) == 1} {
847	set mode "T"
848	set value $newhist(2tLimit)
849	} elseif {$newhist(LimitMode) == 2} {
850	set mode "D"
851	set Q 100
852	catch {set Q [expr {4*acos(0)/$newhist(2tLimit)}]}
853	set value $Q
854	} else {
855	set mode "D"
856	set value $newhist(2tLimit)
857	}
858
859	# ok do it!
860	set errmsg [runAddHist $newhist(rawfile) $newhist(instfile) $newhist(banknum) $newhist(setnum) $mode $value]
861	# save call to Macro file
862	RecordMacroEntry "runAddHist [list $newhist(rawfile)] [list $newhist(instfile)] $newhist(banknum) $newhist(setnum) $mode $value" 0
863
864	destroy $np
865	if {$expgui(showexptool) \|\| $errmsg != ""} {
866	if {$errmsg != ""} {
867	set err 1
868	append errmsg "\n" $expgui(exptoolout)
869	} else {
870	set err 0
871	set errmsg $expgui(exptoolout)
872	}
873	set msg "Please review the result from adding the histogram"
874	if {$errmsg != ""} {append msg "\nIt appears an error occurred!"}
875	ShowBigMessage $np $msg $errmsg OK "" $err
876	}
877	# set the powpref warning (2 = required)
878	set expgui(needpowpref) 2
879	set msg "A histogram was added"
880	if {[string first $msg $expgui(needpowpref_why)] == -1} {
881	append expgui(needpowpref_why) "\t$msg\n"
882	}
883	# select the most recently added histogram
884	if {!$err != ""} {
885	set i [llength $expmap(histlistboxcontents)]
886	if {$i > 0} {
887	incr i -1
888	set expgui(curhist) $i
889	sethistlist
890	}
891	}
892	}
893	proc runAddHist {rawfile instfile banknum setnum mode value} {
894	global expgui expmap tcl_platform
895	set fp [open exptool.in w]
896	puts $fp "H"
897	if {$tcl_platform(platform) == "windows"} {
898	puts $fp [file attributes $rawfile -shortname]
899	puts $fp [file attributes $instfile -shortname]
900	} else {
901	puts $fp $rawfile
902	puts $fp $instfile
903	}
904	puts $fp $banknum
905	puts $fp $setnum
906	puts $fp $mode
907	puts $fp "$value"
908	puts $fp "/"
909	puts $fp "X"
910	puts $fp "X"
911	close $fp
912	# Save the current exp file
913	savearchiveexp
914	# disable the file changed monitor
915	set expgui(expModifiedLast) 0
916	set expnam [file root [file tail $expgui(expfile)]]
917	set err [catch {
918	if {$tcl_platform(platform) == "windows"} {
919	exec [file join $expgui(gsasexe) exptool.exe] $expnam \
920	< exptool.in >& exptool.out
921	} else {
922	exec [file join $expgui(gsasexe) exptool] $expnam \
923	< exptool.in >& exptool.out
924	}
925	} errmsg]
926	# load the revised exp file
927	set oldpowderlist $expmap(powderlist)
928	loadexp $expgui(expfile)
929	if {[llength $oldpowderlist] == [llength $expmap(powderlist)]} {
930	append errmsg "\nNo histogram added"
931	set err 1
932	}
933	set fp [open exptool.out r]
934	set expgui(exptoolout) [read $fp]
935	close $fp
936	catch {file delete exptool.in exptool.out}
937	if {$err} {
938	return $errmsg
939	} else {
940	return ""
941	}
942	}
943
944	proc RunRawplot {parent} {
945	global newhist tcl_platform
946	set f1 $newhist(rawfile)
947	set f2 $newhist(instfile)
948	# for Windows put a message on top, in case file names must be shortened
949	if {$tcl_platform(platform) == "windows"} {
950	catch {set f1 [file nativename \
951	[file attributes $newhist(rawfile) -shortname]]}
952	catch {set f2 [file nativename \
953	[file attributes $newhist(instfile) -shortname]]}
954	}
955	if {$f1 != "" \|\| $f2 != ""} {
956	#set msg "Note: input to RAWPLOT\n"
957	#if {$f1 != ""} {append msg "data file: $f1\n"}
958	#if {$f2 != ""} {append msg "instrument file: $f2"}
959	catch {toplevel $parent.msg}
960	catch {eval destroy [winfo children $parent.msg]}
961	wm title $parent.msg "File names"
962	grid [label $parent.msg.1 \
963	-text "File names to be input to RAWPLOT" \
964	-justify center -anchor center] \
965	-column 0 -row 0 -columnspan 2
966	if {$f1 != ""} {
967	grid [label $parent.msg.2a \
968	-text "Raw histogram: $f1" \
969	-justify center -anchor e] \
970	-column 0 -row 1
971	grid [button $parent.msg.2b \
972	-command "clipboard clear; clipboard append $f1" \
973	-text "put name\nin clipboard"] \
974	-column 1 -row 1
975	}
976	if {$f2 != ""} {
977	grid [label $parent.msg.3a \
978	-text "Raw histogram: $f2" \
979	-justify center -anchor e] \
980	-column 0 -row 2
981	grid [button $parent.msg.3b \
982	-command "clipboard clear; clipboard append $f2" \
983	-text "put name\nin clipboard"] \
984	-column 1 -row 2
985	}
986	grid [button $parent.msg.4 \
987	-command "destroy $parent.msg" \
988	-text "Close"] \
989	-column 0 -columnspan 2 -row 9
990	}
991	# start RAWPLOT
992	runGSASprog rawplot 1
993	if {[winfo exists $parent.msg]} {raise $parent.msg}
994	update
995	}
996	#--- Dummy histogram stuff
997	proc PostDummyOpts {np} {
998	global newhist
999	if {$newhist(dummy)} {
1000	trace variable newhist(tmin) w "ValidateDummyHist $np"
1001	trace variable newhist(tmax) w "ValidateDummyHist $np"
1002	trace variable newhist(tstep) w "ValidateDummyHist $np"
1003	foreach w {l1 t1 lbank} {
1004	$np.$w config -fg grey
1005	}
1006	$np.d1.m1 config -text {}
1007	$np.d1.m2 config -text {}
1008	$np.b1 config -state disabled
1009	grid forget $np.l3 $np.e3 $np.cb3 $np.cb4 $np.cb5 $np.bank $np.f6a
1010	grid $np.dl1 -column 0 -row 18
1011	grid $np.d1 -column 1 -row 18 -rowspan 2 -columnspan 4 -sticky e
1012	grid $np.dl3 -column 0 -columnspan 99 -row 20 -sticky ew
1013	if {$newhist(insttype) == "TOF"} {
1014	$np.dl1 config -text "Data range:\n(TOF)"
1015	$np.d1.lu config -text millisec
1016	grid $np.dl2 -column 0 -row 19
1017	catch {
1018	set s $newhist(setnum)
1019	foreach {x tmin tmax x} $newhist(inst${s}ITYP) {}
1020	$np.d1.m1 config -text $tmin
1021	$np.d1.m2 config -text $tmax
1022	}
1023	} elseif {[lindex $newhist(insttype) 0] == "CW"} {
1024	$np.dl1 config -text "Data range:\n(2Theta)"
1025	$np.d1.lu config -text degrees
1026	#grid forget $np.dl2
1027	$np.d1.m1 config -text >0.
1028	$np.d1.m2 config -text <180.
1029	} elseif {$newhist(insttype) == "ED"} {
1030	$np.dl1 config -text "Data range:\n(Energy)"
1031	$np.d1.lu config -text KeV
1032	$np.d1.m1 config -text 1.
1033	$np.d1.m2 config -text 200.
1034	grid $np.dl2 -column 0 -row 19
1035	} else {
1036	$np.dl1 config -text "No file\nselected"
1037	$np.d1.lu config -text {}
1038	}
1039	} else {
1040	foreach var {tmin tmax tstep} {
1041	foreach v [ trace vinfo newhist($var)] {
1042	eval trace vdelete newhist($var) $v
1043	}
1044	}
1045	grid forget $np.dl1 $np.d1 $np.dl2 $np.dl3
1046	foreach w {l1 t1 lbank} {
1047	$np.$w config -fg black
1048	}
1049	$np.b1 config -state normal
1050	grid $np.bank -column 2 -row 3 -columnspan 7 -sticky ew
1051	grid $np.f6a -column 4 -row 18 -rowspan 3
1052	grid $np.l3 -column 0 -row 18 -rowspan 3
1053	grid $np.e3 -column 1 -row 18 -rowspan 3
1054	grid $np.cb3 -column 2 -row 18 -sticky w
1055	grid $np.cb4 -column 2 -row 20 -sticky w
1056	grid $np.cb5 -column 2 -row 19 -sticky w
1057	}
1058	}
1059
1060	proc ValidateDummyHist {np args} {
1061	# validate input
1062	global newhist
1063	set msg {}
1064	$np.dl3 config -text "\n"
1065	foreach e {e1 e2 e3} v {tmin tmax tstep} {
1066	if [catch {expr $newhist($v)}] {
1067	$np.d1.$e config -fg red
1068	append msg "Value of $newhist($v) is invalid for $v\n"
1069	} else {
1070	$np.d1.$e config -fg black
1071	}
1072	}
1073	if {[catch {expr $newhist(setnum)}]} {
1074	append msg "An instrument file bank number must be selected\n"
1075	} elseif {$newhist(setnum) <= 0 \|\| \
1076	$newhist(setnum) > $newhist(instbanks)} {
1077	append msg "An invalid instrument file bank has been selected\n"
1078	}
1079
1080	if {$msg != ""} {return $msg}
1081
1082	if {$newhist(tmax) <= $newhist(tmin)} {
1083	$np.d1.e1 config -fg red
1084	$np.d1.e2 config -fg red
1085	return "Tmax <= Tmin\n"
1086	}
1087
1088
1089	set dmin -1
1090	set dmax -1
1091	if {$newhist(insttype) == "TOF"} {
1092	catch {
1093	set s $newhist(setnum)
1094	foreach {x tmin tmax x} $newhist(inst${s}ITYP) {}
1095	if {$newhist(tmin) <$tmin } {
1096	$np.d1.e1 config -fg red
1097	append msg "Min value of $newhist(tmin) msec is invalid.\n"
1098	}
1099	if {$newhist(tmax) >$tmax } {
1100	$np.d1.e2 config -fg red
1101	append msg "Max value of $newhist(tmax) msec is invalid.\n"
1102	}
1103	set s $newhist(setnum)
1104	set dmin [expr {1000. * $newhist(tmin) / \
1105	[lindex $newhist(inst${s}ICONS) 0]}]
1106	set dmax [expr {1000. * $newhist(tmax) / \
1107	[lindex $newhist(inst${s}ICONS) 0]}]
1108	}
1109	} elseif {[lindex $newhist(insttype) 0] == "CW"} {
1110	if {$newhist(tmin) <= 0 } {
1111	$np.d1.e1 config -fg red
1112	append msg "Min value of $newhist(tmin) degrees is invalid.\n"
1113	}
1114	if {$newhist(tmax) >=180 } {
1115	$np.d1.e2 config -fg red
1116	append msg "Max value of $newhist(tmax) degrees is invalid.\n"
1117	}
1118	catch {
1119	set s $newhist(setnum)
1120	set dmin [expr {[lindex $newhist(inst${s}ICONS) 0]\
1121	* 0.5 / sin(acos(0.)*$newhist(tmax)/180.)}]
1122	set dmax [expr {[lindex $newhist(inst${s}ICONS) 0]\
1123	* 0.5 / sin(acos(0.)*$newhist(tmin)/180.)}]
1124	}
1125	} else {
1126	if {$newhist(tmin) <1 } {
1127	$np.d1.e1 config -fg red
1128	append msg "Min value of $newhist(tmin) KeV is invalid.\n"
1129	}
1130	if {$newhist(tmax) >200 } {
1131	$np.d1.e2 config -fg red
1132	append msg "Max value of $newhist(tmax) KeV is invalid.\n"
1133	}
1134	catch {
1135	set s $newhist(setnum)
1136	set ang [lindex $newhist(inst${s}ICONS) 0]
1137	set dmin [expr {12.398/ (2.0sin($angacos(0.)/180) * \
1138	$newhist(tmax))}]
1139	set dmax [expr {12.398/ (2.0sin($angacos(0.)/180) * \
1140	$newhist(tmin))}]
1141	}
1142	}
1143	if {$msg != ""} {return $msg}
1144	set pnts -1
1145	catch {
1146	set pnts [expr {1+int(($newhist(tmax) - $newhist(tmin))/$newhist(tstep))}]
1147	set qmin [expr {4.*acos(0)/$dmax}]
1148	set qmax [expr {4.*acos(0)/$dmin}]
1149	}
1150	if {$pnts <= 0} {
1151	$np.d1.e3 config -fg red
1152	append msg "Step value of $newhist(tstep) is invalid.\n"
1153	}
1154	if {$pnts >20000} {
1155	$np.d1.e3 config -fg red
1156	append msg "Step value of $newhist(tstep) is too small (>20000 points).\n"
1157	}
1158	if {$msg != ""} {return $msg}
1159	if {$dmin > 0 && $dmax > 0} {
1160	catch {
1161	set msg [format \
1162	{ %d points.%s D-space range: %.2f-%.2f A, Q: %.2f-%.2f/A} \
1163	$pnts "\n" $dmin $dmax $qmin $qmax]
1164	$np.dl3 config -text $msg
1165	}
1166	}
1167	if {$msg != ""} {return ""}
1168	$np.dl3 config -text [format { %d points.%s Range: ?} $pnts "\n"]
1169	return "Invalid data range -- something is wrong!"
1170	}
1171
1172	proc AddDummyHist {np} {
1173	global newhist expgui expmap
1174	global tcl_platform
1175	set msg [ValidateDummyHist $np]
1176	if {$msg != ""} {
1177	MyMessageBox -parent $np -title "Add Histogram Error" \
1178	-message "The following error(s) were found in your input:\n$msg" \
1179	-icon error -type ok -default ok \
1180	-helplink "expgui3.html AddHistErr"
1181	return
1182	}
1183
1184	set errmsg [runAddDummyHist $newhist(instfile) $newhist(setnum) \
1185	$newhist(insttype) \
1186	$newhist(tmin) $newhist(tmax) $newhist(tstep)]
1187	RecordMacroEntry "runAddDummyHist [list $newhist(instfile)] $newhist(setnum) $newhist(insttype) $newhist(tmin) $newhist(tmax) $newhist(tstep)" 0
1188
1189	if {$errmsg != ""} {
1190	append errmsg "\n" $out
1191	} else {
1192	set errmsg $out
1193	}
1194	if {[regexp {\(P,H,A\)} $expgui(exptoolout)]} {
1195	set msg {You must upgrade the EXPTOOL program.}
1196	append msg { This version cannot add dummy histograms.}
1197	MyMessageBox -icon error -title "Old EXPTOOL program" \
1198	-message $msg -parent $np \
1199	-helplink "expguierr.html OldEXPTOOL"
1200	# update the documentation & link
1201	destroy $np
1202	} elseif {$expgui(showexptool) \|\| $errmsg != ""} {
1203	if {$errmsg != ""} {
1204	set err 1
1205	append errmsg "\n" $expgui(exptoolout)
1206	} else {
1207	set err 0
1208	set errmsg $expgui(exptoolout)
1209	}
1210	set msg "Please review the result from adding the dummy histogram"
1211	if {$err} {append msg "\nIt appears an error occurred!"}
1212	ShowBigMessage $np $msg $errmsg OK "" $err
1213	} else {
1214	destroy $np
1215	}
1216	file delete exptool.in exptool.out
1217	# set the powpref warning (2 = required)
1218	set expgui(needpowpref) 2
1219	set msg "A histogram was added"
1220	if {[string first $msg $expgui(needpowpref_why)] == -1} {
1221	append expgui(needpowpref_why) "\t$msg\n"
1222	}
1223	}
1224	proc runAddDummyHist {instfile setnum insttype tmin tmax tstep} {
1225	global expgui expmap tcl_platform
1226	set fp [open exptool.in w]
1227	puts $fp "D"
1228	puts $fp $instfile
1229	puts $fp $setnum
1230	if {$insttype == "TOF"} {
1231	puts $fp "C"
1232	}
1233	puts $fp $tmin
1234	puts $fp $tmax
1235	puts $fp $tstep
1236	puts $fp "X"
1237	puts $fp "0"
1238	close $fp
1239	# Save the current exp file
1240	savearchiveexp
1241	# disable the file changed monitor
1242	set expgui(expModifiedLast) 0
1243	set expnam [file root [file tail $expgui(expfile)]]
1244	set err [catch {
1245	if {$tcl_platform(platform) == "windows"} {
1246	exec [file join $expgui(gsasexe) exptool.exe] $expnam \
1247	< exptool.in >& exptool.out
1248	} else {
1249	exec [file join $expgui(gsasexe) exptool] $expnam \
1250	< exptool.in >& exptool.out
1251	}
1252	} errmsg ]
1253	# load the revised exp file
1254	set oldpowderlist $expmap(powderlist)
1255	loadexp $expgui(expfile)
1256	set fp [open exptool.out r]
1257	set expgui(exptoolout) [read $fp]
1258	close $fp
1259	catch {file delete exptool.in exptool.out}
1260	if {[llength $oldpowderlist] == [llength $expmap(powderlist)]} {
1261	set err 1
1262	if {$errmsg == ""} {set errmsg "No histogram added"}
1263	}
1264	if {$err} {
1265	return $errmsg
1266	} else {
1267	return ""
1268	}
1269	}
1270
1271	#--- multiple histogram stuff
1272	proc SetMultipleAdd {np} {
1273	global newhist
1274	$np.f6.b6c configure -state disabled
1275	catch {
1276	if {$newhist(instbanks) == [llength $newhist(banklist)] \
1277	&& $newhist(instbanks) > 1} {
1278	$np.f6.b6c configure -state normal
1279	}
1280	}
1281	}
1282
1283	proc addMultiplehist {np} {
1284	global newhist
1285	# should not happen, but just in case
1286	if {$newhist(instbanks) != [llength $newhist(banklist)]} {
1287	$np.f6.b6c configure -state disable
1288	return
1289	}
1290	catch {destroy [set top $np.addMult]}
1291	toplevel $top
1292	grid [canvas $top.canvas \
1293	-scrollregion {0 0 5000 500} -width 0 -height 250 \
1294	-yscrollcommand "$top.scroll set"] \
1295	-column 0 -columnspan 2 -row 2 -sticky ns
1296	grid columnconfigure $top 0 -weight 1
1297	grid rowconfigure $top 2 -weight 1
1298	scrollbar $top.scroll \
1299	-command "$top.canvas yview"
1300	frame [set cfr $top.canvas.fr]
1301	$top.canvas create window 0 0 -anchor nw -window $cfr
1302	grid [label $top.top -text "Select banks to add" -bg beige] \
1303	-column 0 -columnspan 3 -row 0 -sticky ew
1304	grid [frame $top.vartyp -bd 2 -relief groove] \
1305	-column 0 -columnspan 3 -row 1 -sticky ew
1306	grid [label $top.vartyp.top -text "Data limit units:"] -column 0 -row 0 -columnspan 3 -sticky w
1307	grid [radiobutton $top.vartyp.cb3 -text "d-min" -variable newhist(LimitMode) \
1308	-value 0] -column 0 -row 1 -sticky w
1309	grid [radiobutton $top.vartyp.cb4 -textvariable newhist(datalimlbl) \
1310	-variable newhist(LimitMode) -anchor w -justify l \
1311	-value 1] -column 1 -row 1 -sticky w
1312	grid [radiobutton $top.vartyp.cb5 -text "Q-max" -variable newhist(LimitMode) \
1313	-value 2] -column 2 -row 1 -sticky w
1314	set newhist(LimitMode) 1
1315
1316	grid [button $top.add -text Add -command "destroy $np"] -column 0 -row 3
1317	grid [button $top.cancel -text Cancel -command "destroy $top"] \
1318	-column 1 -row 3 -columnspan 2
1319	set row 1
1320	grid [label $cfr.t1 -text "Bank\n#"] -column 0 -row 0
1321	switch $newhist(insttype) {
1322	TOF {set newhist(datalimlbl) "T-min\n(ms)"}
1323	ED {set newhist(datalimlbl) "E-max\n(KeV)"}
1324	default {set newhist(datalimlbl) "2theta\nmax"}
1325	}
1326	grid [label $cfr.t2 -textvariable newhist(datalimlbl)] -column 1 -row 0
1327	foreach i $newhist(banklist) {
1328	grid [checkbutton $cfr.c$i -text $i \
1329	-variable newhist(usebank$i)] \
1330	-column 0 -row [incr row] -sticky w
1331	set newhist(usebank$i) 1
1332	grid [entry $cfr.e$i -width 8 -textvariable newhist(tlimit$i)] \
1333	-column 1 -row $row -sticky w
1334	lappend newhist(LimitMode_boxes) $cfr.e$i
1335	if {$newhist(insttype) == "TOF"} {
1336	set newhist(tlimit$i) $newhist(tmin$i)
1337	} else {
1338	set newhist(tlimit$i) $newhist(tmax$i)
1339	}
1340	}
1341	# resize the list
1342	update
1343	set sizes [grid bbox $top.canvas.fr]
1344	$top.canvas config -scrollregion $sizes -width [lindex $sizes 2]
1345	# use the scroll for BIG lists
1346	if {[lindex $sizes 3] > [winfo height $top.canvas]} {
1347	grid $top.scroll -sticky ns -column 3 -row 2
1348	} else {
1349	grid forget $top.scroll
1350	}
1351	update
1352	putontop $top
1353	tkwait window $top
1354	afterputontop
1355
1356	if {[winfo exists $np]} return
1357
1358	# validate the input
1359	set err {}
1360	if {[string trim $newhist(rawfile)] == ""} {
1361	append err " No data file specified\n"
1362	}
1363	if {[string trim $newhist(instfile)] == ""} {
1364	append err " No instrument parameter file specified\n"
1365	}
1366	foreach i $newhist(banklist) {
1367	if {$newhist(usebank$i)} {
1368	if {[catch {expr $newhist(tlimit$i)}]} {
1369	append err " The Max/Min limit is not valid for bank $i\n"
1370	} elseif {$newhist(tlimit$i) <= 0} {
1371	append err " The Max/Min limit is not valid for bank $i\n"
1372	}
1373	}
1374	}
1375	if {$err != ""} {
1376	MyMessageBox -parent $np -title "Add Histogram Error" \
1377	-message "The following error(s) were found in your input:\n$err" \
1378	-icon error -type ok -default ok \
1379	-helplink "expgui3.html AddHistErr"
1380	return
1381	}
1382
1383	# ok do it!
1384	global tcl_platform expmap expgui
1385	# Save the current exp file
1386	savearchiveexp
1387	set oldpowderlist $expmap(powderlist)
1388	# disable the file changed monitor
1389	set expgui(expModifiedLast) 0
1390	set k 0
1391	set added 0
1392	set outlog {}
1393	set err 0
1394	pleasewait "adding histograms" expgui(temp)
1395	foreach i $newhist(banklist) {
1396	incr k
1397	if {$newhist(usebank$i)} {
1398	incr added
1399	set expgui(temp) "adding bank $i"
1400	update
1401
1402	if {$newhist(LimitMode) == 1} {
1403	set mode "T"
1404	set value $newhist(tlimit$i)
1405	} elseif {$newhist(LimitMode) == 2} {
1406	set mode "D"
1407	set Q 100
1408	catch {set Q [expr {4*acos(0)/$newhist(tlimit$i)}]}
1409	set value $Q
1410	} else {
1411	set mode "D"
1412	set value $newhist(tlimit$i)
1413	}
1414	set errmsg [runAddHist $newhist(rawfile) $newhist(instfile) $i $k $mode $value]
1415	# save call to Macro file
1416	RecordMacroEntry "runAddHist [list $newhist(rawfile)] [list $newhist(instfile)] $i $k $mode $value" 0
1417	if {$errmsg != ""} {
1418	append outlog "\n\n\nNOTE ERROR:\n" $errmsg $expgui(exptoolout)
1419	set err 1
1420	} else {
1421	append outlog $expgui(exptoolout)
1422	}
1423	}
1424	}
1425	# load the revised exp file
1426	loadexp $expgui(expfile)
1427	if {[llength $oldpowderlist]+$added != [llength $expmap(powderlist)]} {
1428	set err 1
1429	}
1430	# set the powpref warning (2 = required)
1431	set expgui(needpowpref) 2
1432	set msg "A histogram was added"
1433	if {[string first $msg $expgui(needpowpref_why)] == -1} {
1434	append expgui(needpowpref_why) "\t$msg\n"
1435	}
1436	donewait
1437	if {$expgui(showexptool) \|\| $err} {
1438	set msg "Please review the result from adding the histogram"
1439	if {$err} {append msg "\nIt appears an error occurred!"}
1440	ShowBigMessage $np $msg $outlog OK "" $err
1441	}
1442	# select the most recently added histogram
1443	if {!$err} {
1444	set i [llength $expmap(histlistboxcontents)]
1445	if {$i > 0} {
1446	incr i -1
1447	set expgui(curhist) $i
1448	sethistlist
1449	}
1450	}
1451	}
1452
1453	#----------- Add Atoms routines ----------------------------------------
1454	proc MakeAddAtomsBox {phase "atomlist {}"} {
1455	global expmap expgui
1456
1457	# is there room for more atoms? Well, we will check this someday
1458	if {$phase == ""} return
1459	if {[llength $phase] != 1} return
1460
1461	set top .newatoms
1462	catch {destroy $top}
1463	toplevel $top
1464	bind $top <Key-F1> "MakeWWWHelp expgui2.html addatoms"
1465
1466	grid [label $top.l1 -relief groove -bd 4 -anchor center\
1467	-text "Adding atoms to phase #$phase"] \
1468	-column 0 -row 0 \
1469	-sticky we -columnspan 10
1470
1471	grid [canvas $top.canvas \
1472	-scrollregion {0 0 5000 500} -width 0 -height 250 \
1473	-yscrollcommand "$top.scroll set"] \
1474	-column 0 -row 2 -columnspan 4 -sticky nsew
1475	grid columnconfigure $top 3 -weight 1
1476	grid rowconfigure $top 2 -weight 1
1477	grid rowconfigure $top 1 -pad 5
1478	scrollbar $top.scroll \
1479	-command "$top.canvas yview"
1480	frame $top.canvas.fr
1481	$top.canvas create window 0 0 -anchor nw -window $top.canvas.fr
1482
1483	set np $top.canvas.fr
1484	set row 0
1485	set col 0
1486	grid [label $np.l_${row}0 -text " # "] -column $col -row $row
1487	foreach i {Atom\ntype Name x y z Occ Uiso} \
1488	var {type name x y z occ uiso} {
1489	grid [button $np.l_${row}$i -text $i -padx 0 -pady 0 \
1490	-command "sortAddAtoms $phase $top $var"] \
1491	-column [incr col] -row $row -sticky nsew
1492	}
1493	grid [label $np.l_${row}Use -text Use\nFlag] -column [incr col] -row $row
1494
1495	set expgui(SetAddAtomsScroll) 0
1496	set i [llength $atomlist]
1497	if {$i == 0} {incr i}
1498	for {set j 0} {$j < $i} {incr j} {
1499	MakeAddAtomsRow $top
1500	}
1501	set row 0
1502	foreach item $atomlist {
1503	incr row
1504	foreach val $item w {n x y z t o u} {
1505	if {$val != ""} {
1506	$np.e${row}$w delete 0 end
1507	$np.e${row}$w insert end $val
1508	}
1509	}
1510	}
1511	bind $top <Configure> "SetAddAtomsScroll $top"
1512	grid rowconfigure $top 3 -min 10
1513	grid [button $top.b1 -text "Add Atoms"\
1514	-command "addatom $phase $top"] -column 0 -row 5 -sticky w
1515	bind $top <Return> "addatom $phase $top"
1516	grid [button $top.b2 -text Cancel \
1517	-command "destroy $top"] -column 1 -row 5 -sticky w
1518	grid [button $top.help -text Help -bg yellow \
1519	-command "MakeWWWHelp expgui2.html addatoms"] \
1520	-column 0 -columnspan 2 -row 4
1521
1522	# get the input formats if not already defined
1523	GetImportFormats
1524	if {[llength $expgui(importFormatList)] > 0} {
1525	grid [frame $top.fr -bd 4 -relief groove] \
1526	-column 3 -row 5 -columnspan 2 -sticky e
1527	grid [button $top.fr.b3 -text "Import atoms from: " \
1528	-command "ImportAtoms \$expgui(importFormat) $top $phase"] \
1529	-column 0 -row 0 -sticky e
1530	set menu [eval tk_optionMenu $top.fr.b4 expgui(importFormat) \
1531	$expgui(importFormatList)]
1532	for {set i 0} {$i <= [$menu index end]} {incr i} {
1533	$menu entryconfig $i -command "ImportAtoms \$expgui(importFormat) $top $phase"
1534	}
1535	grid $top.fr.b4 -column 1 -row 0 -sticky w
1536	grid rowconfig $top.fr 0 -pad 10
1537	grid columnconfig $top.fr 0 -pad 10
1538	grid columnconfig $top.fr 1 -pad 10
1539	}
1540
1541	grid [button $top.b3 -text "More atom boxes" \
1542	-command "MakeAddAtomsRow $top"] -column 3 \
1543	-columnspan 2 -row 4 -sticky e
1544
1545	wm title $top "add new atom"
1546
1547	# set grab, etc.
1548	putontop $top
1549
1550	tkwait window $top
1551
1552	# fix grab...
1553	afterputontop
1554	}
1555
1556	proc MakeAddAtomsRow {top} {
1557	set np $top.canvas.fr
1558	set col -1
1559	set row 1
1560	# find an empty row
1561	while {![catch {grid info $np.e${row}t}]} {incr row}
1562	grid [label $np.e${row}num -text $row] -column [incr col] -row $row
1563	grid [entry $np.e${row}t -width 5] -column [incr col] -row $row
1564	grid [entry $np.e${row}n -width 8] -column [incr col] -row $row
1565	foreach i {x y z o u} {
1566	grid [entry $np.e${row}$i -width 9] -column [incr col] -row $row
1567	}
1568	grid [checkbutton $np.e${row}use -variable expgui(UseAtom$row)] \
1569	-column [incr col] -row $row
1570	# default occupancy
1571	$np.e${row}o delete 0 end
1572	$np.e${row}o insert end 1.0
1573	# default Uiso
1574	$np.e${row}u delete 0 end
1575	$np.e${row}u insert end 0.025
1576	# default label
1577	$np.e${row}n delete 0 end
1578	$np.e${row}n insert end (default)
1579	# use by default
1580	$np.e${row}use select
1581
1582	SetAddAtomsScroll $top
1583	return $row
1584	}
1585
1586	proc SetAddAtomsScroll {top} {
1587	global expgui
1588	if $expgui(SetAddAtomsScroll) return
1589	# prevent reentrance
1590	set expgui(SetAddAtomsScroll) 1
1591	update
1592	set sizes [grid bbox $top.canvas.fr]
1593	$top.canvas config -scrollregion $sizes -width [lindex $sizes 2]
1594	# use the scroll for BIG atom lists
1595	if {[lindex $sizes 3] > [winfo height $top.canvas]} {
1596	grid $top.scroll -sticky ns -column 4 -row 2
1597	} else {
1598	grid forget $top.scroll
1599	}
1600	update
1601	set expgui(SetAddAtomsScroll) 0
1602	}
1603
1604	# Validate the atoms in the atoms add/phase replace box
1605	# returns a null string on error or a list of atoms
1606	proc ValidateAtomsBox {top np} {
1607	global expgui
1608	set row 0
1609	# loop over the defined rows
1610	set err {}
1611	set atomlist {}
1612	set validatmtypes {
1613	H H-1 H_1 H_2 D H_3 HE HE_3 HE_4 LI LI+1 LI_6 LI_7 BE BE+2 B B_10
1614	B_11 C CV C_12 C_13 N N_14 N_15 O O-1 O-2 O_16 O_17 O_18 F F-1 F_19 NE
1615	NE_20 NE_21 NE_22 NA NA+1 NA_23 MG MG+2 MG_24 MG_25 MG_26 AL AL+3
1616	AL_27 SI SI+4 SIV SI_28 SI_29 SI_30 P P_31 S S_32 S_33 S_34 CL CL-1
1617	CL_35 CL_37 AR AR_36 AR_40 K K+1 K_39 K_41 CA CA+2 CA_40 CA_44 SC SC+3
1618	SC_45 TI TI+2 TI+3 TI+4 TI_46 TI_47 TI_48 TI_49 TI_50 V V+2 V+3 V+5
1619	V_51 CR CR+2 CR+3 CR_50 CR_52 CR_53 CR_54 MN MN+2 MN+3 MN+4 MN_55 FE
1620	FE+2 FE+3 FE_54 FE_56 FE_57 FE_58 CO CO+2 CO+3 CO_59 NI NI+2 NI+3
1621	NI_58 NI_60 NI_61 NI_62 NI_64 CU CU+1 CU+2 CU_63 CU_65 ZN ZN+2 ZN_64
1622	ZN_66 ZN_67 ZN_68 GA GA+3 GE GE+4 AS AS_75 SE BR BR-1 BR_79 BR_81 KR
1623	RB RB+1 SR SR+2 Y Y+3 Y_89 ZR ZR+4 NB NB+3 NB+5 NB_93 MO MO+3 MO+5
1624	MO+6 TC TC_98 RU RU+3 RU+4 RH RH+3 RH+4 RH_103 PD PD+2 PD+4 AG AG+1
1625	AG+2 CD CD+2 CD_112 CD_113 CD_114 CD_116 IN IN+3 IN_113 IN_115 SN SN+2
1626	SN+4 SB SB+3 SB+5 TE I I-1 I_127 XE CS CS+1 CS_133 BA BA+2 LA LA+3 CE
1627	CE+3 CE+4 PR PR+3 PR+4 PR_141 ND ND+3 PM PM+3 PM_147 SM SM+3 SM_152
1628	SM_154 EU EU+2 EU+3 EU_153 GD GD+3 GD_160 TB TB+3 TB_159 DY DY+3 HO
1629	HO+3 HO_165 ER ER+3 TM TM+3 TM_169 YB YB+2 YB+3 LU LU+3 HF HF+4 TA
1630	TA+5 TA_181 W W+6 RE OS OS+4 IR IR+3 IR+4 PT PT+2 PT+4 AU AU+1 AU+3
1631	AU_197 HG HG+1 HG+2 TL TL+1 TL+3 PB PB+2 PB+4 BI BI+3 BI+5 BI_209 PO
1632	PO_210 AT AT_210 RN RN_222 FR FR_223 RA RA+2 RA_226 AC AC+3 AC_227 TH
1633	TH+4 TH_232 PA PA_231 U U+3 U+4 U+6 U_235 U_238 NP NP+3 NP+4 NP+6
1634	NP_237 PU PU+3 PU+4 PU+6 PU_239 PU_240 PU_242 AM AM_243 CM CM_244 BK
1635	BK_247 CF CF_249
1636	}
1637	# loop over the defined rows
1638	while {![catch {grid info $np.e[incr row]t}]} {
1639	if !{$expgui(UseAtom$row)} continue
1640	# ignore blank entries
1641	set line {}
1642	foreach i {t x y z} {
1643	append line [string trim [$np.e${row}$i get]]
1644	}
1645	if {$line == ""} continue
1646
1647	# validate the input
1648	if {[set type [string trim [$np.e${row}t get]]] == ""} {
1649	append err " line $row: No atom type specified\n"
1650	}
1651	if {[lsearch $validatmtypes [string toupper $type]] == -1} {
1652	append err " line $row: Atom type $type is not defined for x-rays in GSAS. If you are fitting magnetic scattering, this could be defined. If so, use a different type and use EXPEDT to change the type back.\n\n"
1653	}
1654	set name [string trim [$np.e${row}n get]]
1655	if {$name == "(default)"} {set name "/"}
1656	if {$name == ""} {set name "/"}
1657	foreach i {x y z o u} n {x y z Occ Uiso} {
1658	if {[set $i [string trim [$np.e${row}$i get]]] == ""} {
1659	append err " line $row: No value specified for $n\n"
1660	} elseif {[catch {expr [set $i]}]} {
1661	append err " line $row: The value for $n is invalid\n"
1662	}
1663	}
1664	lappend atomlist "$type $x $y $z $o $name I $u"
1665	}
1666	if {$err != ""} {
1667	MyMessageBox -icon warning -message "Note Errors:\n$err" -parent $top
1668	return {}
1669	}
1670	if {[llength $atomlist] == 0} {
1671	MyMessageBox -icon warning -message "No atoms to load!" -parent $top
1672	return {}
1673	}
1674	return $atomlist
1675	}
1676
1677	proc runAddAtoms {phase atomlist} {
1678	global expgui env expmap tcl_platform
1679	# needed in UNIX
1680	set env(ATOMDATA) [file join $expgui(gsasdir) data atmdata.dat]
1681	set env(gsas) [file nativename $expgui(gsasdir)]
1682	# needed in Windows
1683	set env(GSAS) [file nativename $expgui(gsasdir)]
1684
1685	set fp [open exptool.in w]
1686	puts $fp "A"
1687	puts $fp $phase
1688	# number of atoms
1689	puts $fp [llength $atomlist]
1690	foreach atomline $atomlist {
1691	puts $fp $atomline
1692	}
1693	close $fp
1694
1695	# Save the current exp file
1696	savearchiveexp
1697	# disable the file changed monitor
1698	set expgui(expModifiedLast) 0
1699	set expnam [file root [file tail $expgui(expfile)]]
1700
1701	set err [catch {
1702	if {$tcl_platform(platform) == "windows"} {
1703	exec [file join $expgui(gsasexe) exptool.exe] $expnam \
1704	< exptool.in >& exptool.out
1705	} else {
1706	exec [file join $expgui(gsasexe) exptool] $expnam \
1707	< exptool.in >& exptool.out
1708	}
1709	} errmsg]
1710	# load the revised exp file
1711	set oldatomlist $expmap(atomlist_$phase)
1712	loadexp $expgui(expfile)
1713	set fp [open exptool.out r]
1714	set expgui(exptoolout) [read $fp]
1715	close $fp
1716	catch {file delete exptool.in exptool.out}
1717	if {[llength $oldatomlist] == [llength $expmap(atomlist_$phase))]} {
1718	set err 1
1719	if {$errmsg == ""} {set errmsg "No atom(s) added"}
1720	}
1721	}
1722
1723	proc addatom {phase top} {
1724	global expgui env expmap
1725	set np $top.canvas.fr
1726	# validate the atoms info
1727	set atomlist [ValidateAtomsBox $top $np]
1728	if {$atomlist == ""} return
1729
1730	# ok add the atoms!
1731	set errmsg [runAddAtoms $phase $atomlist]
1732	RecordMacroEntry "runAddAtoms $phase [list $atomlist]" 0
1733
1734	destroy $top
1735	set err 0
1736	if {$errmsg != ""} {
1737	append errmsg "\n" $expgui(exptoolout)
1738	set err 1
1739	} else {
1740	set errmsg $expgui(exptoolout)
1741	}
1742	if {$expgui(showexptool) \|\| $err} {
1743	set msg "Please review the result from adding the atom(s)"
1744	if {$err} {append msg "\nIt appears an error occurred!"}
1745	ShowBigMessage $top $msg $errmsg OK "" $err
1746	}
1747	}
1748
1749	#---------------------------------------------------------------------------
1750	# commands to modify a group of selected atoms
1751	#---------------------------------------------------------------------------
1752
1753	# make the dialog to choose an action
1754	proc MakeXformAtomsBox {phase} {
1755	global expgui expmap
1756	set numberList {}
1757	set p $expgui(curPhase)
1758	foreach AtomIndex $expgui(selectedatomlist) {
1759	# get atom number & phase
1760	set tuple [lindex $expmap(atomlistboxcontents) $AtomIndex]
1761	lappend numberList [lindex $tuple 0]
1762	}
1763	if {$numberList == ""} return
1764	if {[llength $numberList] > 1} {
1765	set suffix s
1766	set suffixy "ies"
1767	} else {
1768	set suffix ""
1769	set suffixy "y"
1770	}
1771	set w .global
1772	catch {destroy $w}
1773	toplevel $w
1774	wm title $w "Edit Atomic Parameter -- phase #$phase"
1775	bind $w <Key-F1> "MakeWWWHelp expgui2.html xform"
1776	# this needs to track by phase
1777	grid [label $w.0 \
1778	-text "Modifying atom${suffix} [CompressList $numberList] Phase $phase" \
1779	-bg yellow -anchor center] -row 0 -column 0 -columnspan 10 \
1780	-sticky nsew
1781	grid rowconfigure $w 0 -pad 5
1782	grid rowconfigure $w 1 -minsize 2
1783
1784	grid [TitleFrame $w.1 -bd 6 -relief groove -text "Modify coordinates"] \
1785	-row 2 -column 0 -columnspan 10 -sticky news
1786	set w1 [$w.1 getframe]
1787	set row 0
1788	foreach v {x y z} {
1789	incr row
1790	set col -1
1791	grid [label $w1.l$v -text "new $v = "] -column [incr col] -row $row
1792	foreach o {x y z} {
1793	grid [entry $w1.e${v}${o} -width 6] -column [incr col] -row $row
1794	$w1.e${v}${o} delete 0 end
1795	if {$v == $o} {
1796	$w1.e${v}${o} insert end "1.0"
1797	} else {
1798	$w1.e${v}${o} insert end "0."
1799	}
1800	grid [label $w1.p${v}${o} -text " $o + "] \
1801	-column [incr col] -row $row
1802	}
1803	grid [entry $w1.e${v} -width 6] -column [incr col] -row $row
1804	$w1.e${v} delete 0 end
1805	$w1.e${v} insert end "0."
1806	}
1807	grid [button $w1.do -text "Transform Coordinates" \
1808	-command "XformAtomsCoord $phase [list $numberList] $w1" \
1809	] -row [incr row] -column 0 -columnspan 10
1810
1811	set shift [GetOrigin1Shift $phase]
1812	grid [button $w1.d1 -text "Xform Origin 1 to Origin 2" \
1813	-command "XformAtoms2Origin2 $phase [list $numberList] $w1 [list $shift]" \
1814	] -row [incr row] -column 3 -columnspan 10 -sticky e
1815	if {$shift == ""} {$w1.d1 config -state disabled}
1816
1817	grid [button $w1.d4 -text "Reset Multiplicities" \
1818	-command "ResetMultiplicities $phase $w" \
1819	] -row $row -column 0 -columnspan 3 -sticky w
1820
1821
1822	grid rowconfigure $w 3 -minsize 5
1823	grid [TitleFrame $w.4 -bd 6 -relief groove -text "Modify occupanc${suffixy}"] \
1824	-row 4 -column 0 -columnspan 10 -sticky news
1825	set w2 [$w.4 getframe]
1826	grid [label $w2.1 -text "Occupancy: "] -row 1 -column 0
1827	grid [entry $w2.e -width 10] -column 1 -row 1
1828	$w2.e delete 0 end
1829	$w2.e insert end 1.0
1830	grid columnconfigure $w2 2 -weight 1
1831	grid [button $w2.do -text "Set Occupanc${suffixy}" \
1832	-command "XformAtomsOcc $phase [list $numberList] $w2" \
1833	] -row 2 -column 0 -columnspan 10
1834
1835	grid rowconfigure $w 5 -minsize 5
1836	grid [TitleFrame $w.6 -bd 6 -relief groove \
1837	-text "Modify Displacement Parameter$suffix"] \
1838	-row 6 -column 0 -columnspan 10 -sticky news
1839	set w2 [$w.6 getframe]
1840	grid [entry $w2.e -width 10] -column 1 -row 1
1841	$w2.e delete 0 end
1842	$w2.e insert end 0.025
1843	grid columnconfigure $w2 2 -weight 1
1844	grid [button $w2.do -text "Set U" \
1845	-command "XformAtomsU $phase [list $numberList] $w2" \
1846	] -row 2 -column 0 -columnspan 10
1847	grid [frame $w2.f] -row 3 -column 0 -columnspan 10
1848
1849	if {[lindex $expmap(phasetype) [expr {$p - 1}]] != 4} {
1850	grid [label $w2.1 -text "Uiso or Uequiv: "] -row 1 -column 0
1851	grid [button $w2.f.iso -text "Set Isotropic" \
1852	-command "XformAtomsU $phase [list $numberList] iso" \
1853	] -row 0 -column 0
1854	grid [button $w2.f.aniso -text "Set Anisotropic" \
1855	-command "XformAtomsU $phase [list $numberList] aniso" \
1856	] -row 0 -column 1
1857	} else {
1858	grid [label $w2.1 -text "Uiso: "] -row 1 -column 0
1859	}
1860
1861	grid rowconfigure $w 7 -minsize 5
1862	if {[lindex $expmap(phasetype) [expr {$p - 1}]] != 4} {
1863	grid [TitleFrame $w.8 -bd 6 -relief groove \
1864	-text "Erase Atom$suffix"] \
1865	-row 8 -column 0 -columnspan 10 -sticky news
1866	set w2 [$w.8 getframe]
1867	grid [button $w2.do -text "Erase Atom${suffix}" \
1868	-command "EraseAtoms $phase [list $numberList] $w" \
1869	] -row 2 -column 0 -columnspan 10
1870	}
1871
1872	grid rowconfigure $w 11 -minsize 5
1873	grid [frame $w.b] -row 12 -column 0 -columnspan 10 -sticky ew
1874	pack [button $w.b.3 -text Close -command "destroy $w"] -side left \
1875	-padx 5 -pady 5
1876	pack [button $w.b.help -text Help -bg yellow \
1877	-command "MakeWWWHelp expgui2.html xform"] -side right \
1878	-padx 5 -pady 5
1879	bind $w <Return> "destroy $w"
1880
1881	# force the window to stay on top
1882	putontop $w
1883	focus $w.b.3
1884	tkwait window $w
1885	afterputontop
1886	# if there are selected atoms, reset their display
1887	if {[llength $expgui(selectedatomlist)] != 0} editRecord
1888	}
1889
1890	# transform the coordinates
1891	proc XformAtomsCoord {phase numberList w1} {
1892	global expgui expmap
1893	if {[lindex $expmap(phasetype) [expr {$phase - 1}]] == 4} {
1894	set cmd mmatominfo
1895	} else {
1896	set cmd atominfo
1897	}
1898	# get the matrix
1899	foreach v {x y z} {
1900	foreach o {x y z} {
1901	set matrix(${v}${o}) [$w1.e${v}${o} get]
1902	}
1903	set matrix(${v}) [$w1.e${v} get]
1904	}
1905	foreach atom $numberList {
1906	foreach v {x y z} {
1907	set $v [$cmd $phase $atom $v]
1908	}
1909	foreach v {x y z} {
1910	set new$v $matrix(${v})
1911	foreach o {x y z} {
1912	set new$v [expr [set new$v] + $matrix(${v}${o})*[set $o]]
1913	}
1914	$cmd $phase $atom $v set [set new$v]
1915	RecordMacroEntry "$cmd $phase $atom $v set [set new$v]" 0
1916	}
1917	incr expgui(changed)
1918	}
1919	RecordMacroEntry "incr expgui(changed)" 0
1920	# update multiplicities for the phase
1921	set parent [winfo toplevel $w1]
1922	ResetMultiplicities $phase $parent
1923	SelectOnePhase $phase
1924	MyMessageBox -parent $parent -type OK -default ok -title "Transform applied" \
1925	-message "The coordinates of atoms [CompressList $numberList] have been transformed"
1926	# UpdateAtomLine $numberList $phase
1927	destroy $parent
1928	}
1929
1930	# set the occupancies to a single value
1931	proc XformAtomsOcc {phase numberList w2} {
1932	global expgui expmap
1933	if {[lindex $expmap(phasetype) [expr {$phase - 1}]] == 4} {
1934	set cmd mmatominfo
1935	} else {
1936	set cmd atominfo
1937	}
1938	# get the value
1939	set val [$w2.e get]
1940	foreach atom $numberList {
1941	$cmd $phase $atom frac set $val
1942	RecordMacroEntry "$cmd $phase $atom frac set $val" 0
1943	incr expgui(changed)
1944	}
1945	RecordMacroEntry "incr expgui(changed)" 0
1946	UpdateAtomLine $numberList $phase
1947	}
1948
1949	# transform Uiso or Uij; if anisotropic set Uequiv to Uij
1950	proc XformAtomsU {phase numberList w2} {
1951	global expgui
1952	set istart $expgui(changed)
1953	if {$w2 == "iso"} {
1954	foreach atom $numberList {
1955	if {[atominfo $phase $atom temptype] != "I"} {
1956	atominfo $phase $atom temptype set I
1957	RecordMacroEntry "atominfo $phase $atom temptype set I" 0
1958	incr expgui(changed)
1959	}
1960	}
1961	} elseif {$w2 == "aniso"} {
1962	foreach atom $numberList {
1963	if {[atominfo $phase $atom temptype] == "I"} {
1964	atominfo $phase $atom temptype set A
1965	RecordMacroEntry "atominfo $phase $atom temptype set A" 0
1966	incr expgui(changed)
1967	}
1968	}
1969	} else {
1970	# get the value
1971	set val [$w2.e get]
1972	foreach atom $numberList {
1973	global expmap
1974	if {[lindex $expmap(phasetype) [expr {$phase - 1}]] == 4} {
1975	mmatominfo $phase $atom Uiso set $val
1976	RecordMacroEntry "mmatominfo $phase $atom Uiso set $val" 0
1977	} elseif {[atominfo $phase $atom temptype] == "I"} {
1978	atominfo $phase $atom Uiso set $val
1979	RecordMacroEntry "atominfo $phase $atom Uiso set $val" 0
1980	} else {
1981	foreach var {U11 U22 U33} {
1982	atominfo $phase $atom $var set $val
1983	RecordMacroEntry "atominfo $phase $atom $var set $val" 0
1984	}
1985	foreach var {U12 U13 U23} {
1986	atominfo $phase $atom $var set 0.0
1987	RecordMacroEntry "atominfo $phase $atom $var set 0.0" 0
1988	}
1989	}
1990	incr expgui(changed)
1991	}
1992	}
1993	if {$istart != $expgui(changed)} {RecordMacroEntry "incr expgui(changed)" 0}
1994	UpdateAtomLine $numberList $phase
1995	}
1996
1997	# confirm and erase atoms
1998	proc EraseAtoms {phase numberList w2} {
1999	global expgui
2000	if {[llength $numberList] <= 0} return
2001	# make a list of atoms
2002	foreach atom $numberList {
2003	append atomlist "\n\t$atom [atominfo $phase $atom label]"
2004	}
2005	set msg "OK to remove the following [llength $numberList] atoms from phase $phase:$atomlist"
2006	set val [MyMessageBox -parent $w2 -type okcancel -icon warning \
2007	-default cancel -title "Confirm Erase" -message $msg]
2008	if {$val == "ok"} {
2009	foreach atom $numberList {
2010	EraseAtom $atom $phase
2011	RecordMacroEntry "EraseAtom $atom $phase" 0
2012	incr expgui(changed)
2013	}
2014	RecordMacroEntry "incr expgui(changed)" 0
2015	mapexp
2016	RecordMacroEntry "mapexp" 0
2017	DisplayAllAtoms $phase
2018	destroy $w2
2019	}
2020	}
2021
2022	#----------- more Add Phase routines (import) -------------------------------
2023	proc ImportPhase {format np} {
2024	global expgui
2025	if {[llength $expgui(extensions_$format)] == 1} {
2026	lappend typelist [list $format $expgui(extensions_$format)]
2027	} else {
2028	foreach item $expgui(extensions_$format) {
2029	lappend typelist [list "All $format" $item]
2030	lappend typelist [list "$format $item" $item]
2031	}
2032	}
2033	lappend typelist [list "All files" *]
2034	set file [tk_getOpenFile -parent $np -filetypes $typelist]
2035	if {![file exists $file]} return
2036	# read in the file
2037	set input [$expgui(proc_$format) $file]
2038	catch {
2039	$np.bf.b1 config -text "Continue" -command "addphase $np; AddAtomsList"
2040	bind $np <Return> "addphase $np; AddAtomsList"
2041	}
2042	catch {
2043	$np.t1 delete 0 end
2044	$np.t1 insert end "from $file"
2045	}
2046	$np.t2 delete 0 end
2047	$np.t2 insert end [lindex $input 0]
2048	foreach i {.e1a .e1b .e1c .e2a .e2b .e2g} val [lindex $input 1] {
2049	$np.f$i delete 0 end
2050	$np.f$i insert end $val
2051	}
2052	set expgui(coordList) [lindex $input 2]
2053	set msg [lindex $input 3]
2054	if {$msg != ""} {
2055	catch {destroy $np.msg}
2056	grid [label $np.msg -text $msg -fg red -anchor center -bd 4 -relief raised] \
2057	-column 0 -columnspan 99 -row 20 -sticky ew
2058	}
2059	}
2060
2061	proc ImportAtoms {format top phase} {
2062	global expgui
2063	if {[llength $expgui(extensions_$format)] == 1} {
2064	set typelist [list $format $item]
2065	} else {
2066	foreach item $expgui(extensions_$format) {
2067	lappend typelist [list "All $format" $item]
2068	lappend typelist [list "$format $item" $item]
2069	}
2070	}
2071	lappend typelist [list "All files" *]
2072	set file [tk_getOpenFile -parent $top -filetypes $typelist]
2073	if {![file exists $file]} return
2074	# disable during read
2075	catch {
2076	foreach b "$top.b1 $top.b2 $top.fr.b3" {
2077	$b config -state disabled
2078	}
2079	}
2080	# read in the file
2081	set input [$expgui(proc_$format) $file]
2082	# add atoms to table
2083	foreach item [lindex $input 2] {
2084	set row [MakeAddAtomsRow $top]
2085	set np $top.canvas.fr
2086	foreach val $item w {n x y z t o u} {
2087	if {$val != ""} {
2088	$np.e${row}$w delete 0 end
2089	$np.e${row}$w insert end $val
2090	}
2091	}
2092	}
2093	# sort the atoms by number, so that empty entries are at the bottom
2094	sortAddAtoms $phase $top number
2095	# reenable
2096	catch {
2097	foreach b "$top.b1 $top.b2 $top.fr.b3" {
2098	$b config -state normal
2099	}
2100	}
2101	}
2102
2103	proc AddAtomsList {} {
2104	global expgui expmap
2105	# skip if we aborted out of addphase
2106	if {$expgui(oldphaselist) == -1} return
2107	# find the new phase
2108	set phase {}
2109	foreach p $expmap(phaselist) {
2110	if {[lsearch $expgui(oldphaselist) $p] == -1} {
2111	set phase $p
2112	break
2113	}
2114	}
2115	if {$phase == ""} return
2116	MakeAddAtomsBox $phase $expgui(coordList)
2117	}
2118
2119	# get the input formats by sourcing files named import_*.tcl
2120	proc GetImportFormats {} {
2121	global expgui tcl_platform
2122	# only needs to be done once
2123	if [catch {set expgui(importFormatList)}] {
2124	set filelist [glob -nocomplain [file join $expgui(scriptdir) import_*.tcl]]
2125	foreach file $filelist {
2126	set description ""
2127	source $file
2128	if {$description != ""} {
2129	lappend expgui(importFormatList) $description
2130	if {$tcl_platform(platform) == "unix"} {
2131	set extensions "[string tolower $extensions] [string toupper $extensions]"
2132	}
2133	set expgui(extensions_$description) $extensions
2134	set expgui(proc_$description) $procname
2135	}
2136	}
2137	}
2138	}
2139
2140	proc MakeReplacePhaseBox {} {
2141	global expmap expgui tcl_platform
2142
2143	set expgui(coordList) {}
2144	# ignore the command if no phase is selected
2145	foreach p {1 2 3 4 5 6 7 8 9} {
2146	if {[lsearch $expmap(phaselist) $expgui(curPhase)] == -1} {
2147	return
2148	}
2149	}
2150
2151	set top .newphase
2152	catch {destroy $top}
2153	toplevel $top
2154	bind $top <Key-F1> "MakeWWWHelp expgui2.html replacephase"
2155
2156	grid [label $top.l1 -text "Replacing phase #$expgui(curPhase)" \
2157	-bg yellow -anchor center] -column 0 -columnspan 8 -row 0 -sticky ew
2158	grid [label $top.l3a -text "Current Space Group: "] \
2159	-column 0 -row 2 -columnspan 2 -sticky e
2160	grid [label $top.l3b -text [phaseinfo $expgui(curPhase) spacegroup]\
2161	-bd 4 -relief groove] \
2162	-column 2 -row 2 -sticky ew
2163	grid [label $top.l4 -text "New Space Group: "] \
2164	-column 0 -row 3 -columnspan 2 -sticky e
2165	grid [entry $top.t2 -width 12] -column 2 -row 3 -sticky w
2166	grid [radiobutton $top.r1 -text "Reenter current atoms"\
2167	-variable expgui(DeleteAllAtoms) -value 0] \
2168	-column 1 -row 4 -columnspan 8 -sticky w
2169	grid [radiobutton $top.r2 -text "Delete current atoms" \
2170	-variable expgui(DeleteAllAtoms) -value 1] \
2171	-column 1 -row 5 -columnspan 8 -sticky w
2172
2173	grid [frame $top.f -bd 4 -relief groove] \
2174	-column 3 -row 2 -columnspan 3 -rowspan 4
2175	set col -1
2176	foreach i {a b c} {
2177	grid [label $top.f.l1$i -text " $i "] -column [incr col] -row 1
2178	grid [entry $top.f.e1$i -width 12] -column [incr col] -row 1
2179	$top.f.e1$i delete 0 end
2180	$top.f.e1$i insert 0 [phaseinfo $expgui(curPhase) $i]
2181	}
2182	set col -1
2183	foreach i {a b g} var {alpha beta gamma} {
2184	grid [label $top.f.l2$i -text $i] -column [incr col] -row 2
2185	set font [$top.f.l2$i cget -font]
2186	$top.f.l2$i config -font "Symbol [lrange $font 1 end]"
2187	grid [entry $top.f.e2$i -width 12] -column [incr col] -row 2
2188	$top.f.e2$i delete 0 end
2189	$top.f.e2$i insert 0 [phaseinfo $expgui(curPhase) $var]
2190	}
2191
2192	grid [button $top.b1 -text Continue \
2193	-command "replacephase1 $top $expgui(curPhase)"] \
2194	-column 0 -row 6 -sticky w
2195	bind $top <Return> "replacephase1 $top $expgui(curPhase)"
2196	grid [button $top.b2 -text Cancel \
2197	-command "destroy $top"] -column 1 -row 6 -sticky w
2198	grid [button $top.help -text Help -bg yellow \
2199	-command "MakeWWWHelp expgui2.html replacephase"] \
2200	-column 2 -row 6
2201
2202	# get the input formats if not already defined
2203	GetImportFormats
2204	if {[llength $expgui(importFormatList)] > 0} {
2205	grid [frame $top.fr -bd 4 -relief groove] \
2206	-column 2 -row 6 -columnspan 8 -sticky e
2207	grid [button $top.fr.b3 -text "Import phase from: " \
2208	-command "ImportPhase \$expgui(importFormat) $top"] \
2209	-column 0 -row 0 -sticky e
2210	set menu [eval tk_optionMenu $top.fr.b4 expgui(importFormat) \
2211	$expgui(importFormatList)]
2212	for {set i 0} {$i <= [$menu index end]} {incr i} {
2213	$menu entryconfig $i -command "ImportPhase \$expgui(importFormat) $top"
2214	}
2215	grid $top.fr.b4 -column 1 -row 0 -sticky w
2216	grid rowconfig $top.fr 0 -pad 10
2217	grid columnconfig $top.fr 0 -pad 10
2218	grid columnconfig $top.fr 1 -pad 10
2219	# grid columnconfig $top 4 -weight 1
2220	grid columnconfig $top 2 -weight 1
2221	}
2222
2223	wm title $top "Replace phase $expgui(curPhase)"
2224
2225	# set grab, etc.
2226	putontop $top
2227
2228	tkwait window $top
2229
2230	# fix grab...
2231	afterputontop
2232	}
2233
2234	proc replacephase1 {top phase} {
2235	# validate cell & space group & save to pass
2236	global expgui expmap
2237	set expgui(SetAddAtomsScroll) 0
2238	# validate the input
2239	set err {}
2240	set spg [$top.t2 get]
2241	if {[string trim $spg] == ""} {
2242	append err " Space group cannot be blank\n"
2243	}
2244	set cell {}
2245	foreach i {a b c a b g} lbl {a b c alpha beta gamma} n {1 1 1 2 2 2} {
2246	set $lbl [$top.f.e${n}$i get]
2247	if {[string trim [set $lbl]] == ""} {
2248	append err " $lbl cannot be blank\n"
2249	} elseif {[catch {expr [set $lbl]}]} {
2250	append err " [set $lbl] is not valid for $lbl\n"
2251	}
2252	lappend cell [set $lbl]
2253	}
2254
2255	if {$err != ""} {
2256	MyMessageBox -parent $top -title "Replace Phase Error" -icon warning \
2257	-message "The following error(s) were found in your input:\n$err"
2258	return
2259	}
2260
2261	# check the space group
2262	set fp [open spg.in w]
2263	puts $fp "N"
2264	puts $fp "N"
2265	puts $fp $spg
2266	puts $fp "Q"
2267	close $fp
2268	global tcl_platform
2269	catch {
2270	if {$tcl_platform(platform) == "windows"} {
2271	exec [file join $expgui(gsasexe) spcgroup.exe] < spg.in >& spg.out
2272	} else {
2273	exec [file join $expgui(gsasexe) spcgroup] < spg.in >& spg.out
2274	}
2275	}
2276	set fp [open spg.out r]
2277	set out [read $fp]
2278	close $fp
2279	# attempt to parse out the output (fix up if parse did not work)
2280	if {[regexp "space group symbol.>(.)Enter a new space group symbol" \
2281	$out a b ] != 1} {set b $out}
2282	if {[string first Error $b] != -1} {
2283	# got an error, show it
2284	ShowBigMessage \
2285	$top.error \
2286	"Error processing space group\nReview error message below" \
2287	$b OK "" 1
2288	return
2289	} else {
2290	# show the result and confirm
2291	set opt [ShowBigMessage \
2292	$top.check \
2293	"Check the symmetry operators in the output below" \
2294	$b \
2295	{Continue Redo} ]
2296	if {$opt > 1} return
2297	}
2298	file delete spg.in spg.out
2299	# draw coordinates box
2300	eval destroy [winfo children $top]
2301	grid [label $top.l1 -relief groove -bd 4 -anchor center\
2302	-text "Atom list for phase #$phase"] \
2303	-column 0 -row 0 \
2304	-sticky we -columnspan 10
2305	grid [canvas $top.canvas \
2306	-scrollregion {0 0 5000 500} -width 0 -height 250 \
2307	-yscrollcommand "$top.scroll set"] \
2308	-column 0 -row 2 -columnspan 4 -sticky nsew
2309	grid columnconfigure $top 3 -weight 1
2310	grid rowconfigure $top 2 -weight 1
2311	grid rowconfigure $top 1 -pad 5
2312	scrollbar $top.scroll \
2313	-command "$top.canvas yview"
2314	frame $top.canvas.fr
2315	$top.canvas create window 0 0 -anchor nw -window $top.canvas.fr
2316
2317	set np $top.canvas.fr
2318	set row 0
2319	set col 0
2320	grid [label $np.l_${row}0 -text " # "] -column $col -row $row
2321	foreach i {Atom\ntype Name x y z Occ Uiso} \
2322	var {type name x y z occ uiso} {
2323	grid [button $np.l_${row}$i -text $i -padx 0 -pady 0 \
2324	-command "sortAddAtoms $phase $top $var"] \
2325	-column [incr col] -row $row -sticky nsew
2326	}
2327	grid [label $np.l_${row}Use -text Use\nFlag] -column [incr col] -row $row
2328
2329	# add the old atoms, if appropriate
2330	if {!$expgui(DeleteAllAtoms)} {
2331	# loop over all atoms
2332	foreach atom $expmap(atomlist_$phase) {
2333	set row [MakeAddAtomsRow $top]
2334	# add all atoms in the current phase to the list
2335	foreach w {n x y z t o} var {label x y z type frac} {
2336	$np.e${row}$w delete 0 end
2337	$np.e${row}$w insert end [atominfo $phase $atom $var]
2338	}
2339	$np.e${row}u delete 0 end
2340	if {[atominfo $phase $atom temptype] == "I"} {
2341	$np.e${row}u insert end [atominfo $phase $atom Uiso]
2342	} else {
2343	$np.e${row}u insert end [expr ( \
2344	[atominfo $phase $atom U11] + \
2345	[atominfo $phase $atom U22] + \
2346	[atominfo $phase $atom U33]) / 3.]
2347	}
2348	}
2349	}
2350
2351	# add coordinates that have been read in, if any
2352	foreach item $expgui(coordList) {
2353	set row [MakeAddAtomsRow $top]
2354	foreach val $item w {n x y z t o u} {
2355	if {$val != ""} {
2356	$np.e${row}$w delete 0 end
2357	$np.e${row}$w insert end $val
2358	}
2359	}
2360	}
2361	# a blank spot in the table
2362	MakeAddAtomsRow $top
2363
2364	bind $top <Configure> "SetAddAtomsScroll $top"
2365	grid rowconfigure $top 3 -min 10
2366	grid [button $top.b1 -text "Continue"\
2367	-command "replacephase2 $phase $top [list $spg] [list $cell]"] \
2368	-column 0 -row 5 -sticky w
2369	bind $top <Return> "replacephase2 $phase $top [list $spg] [list $cell]"
2370	grid [button $top.b2 -text Cancel \
2371	-command "destroy $top"] -column 1 -row 5 -sticky w
2372	if {[llength $expgui(importFormatList)] > 0} {
2373	grid [frame $top.fr -bd 4 -relief groove] \
2374	-column 3 -row 5 -columnspan 2 -sticky e
2375	grid [button $top.fr.b3 -text "Import atoms from: " \
2376	-command "ImportAtoms \$expgui(importFormat) $top $phase"] \
2377	-column 0 -row 0 -sticky e
2378	set menu [eval tk_optionMenu $top.fr.b4 expgui(importFormat) \
2379	$expgui(importFormatList)]
2380	for {set i 0} {$i <= [$menu index end]} {incr i} {
2381	$menu entryconfig $i -command "ImportAtoms \$expgui(importFormat) $top $phase"
2382	}
2383	grid $top.fr.b4 -column 1 -row 0 -sticky w
2384	grid rowconfig $top.fr 0 -pad 10
2385	grid columnconfig $top.fr 0 -pad 10
2386	grid columnconfig $top.fr 1 -pad 10
2387	}
2388
2389	grid [button $top.b3 -text "More atom boxes" \
2390	-command "MakeAddAtomsRow $top"] -column 3 \
2391	-columnspan 2 -row 4 -sticky e
2392
2393	wm title $top "Replacing phase: Enter atoms"
2394	SetAddAtomsScroll $top
2395
2396	# fix grab for old window
2397	afterputontop
2398	# set grab, etc.
2399	putontop $top
2400	}
2401
2402	proc replacephase2 {phase top spg cell} {
2403	global expgui expmap
2404	# validate coordinates
2405	set np $top.canvas.fr
2406	# validate the atoms info
2407	set atomlist [ValidateAtomsBox $top $np]
2408	if {$atomlist == ""} return
2409
2410	pleasewait "updating phase"
2411	replacephase3 $phase [list $spg] [list $cell] [list $atomlist]
2412
2413	set err 0
2414	if {[llength $atomlist] != [llength $expmap(atomlist_$phase))]} {
2415	set err 1
2416	}
2417	if {$errmsg != ""} {
2418	append errmsg "\n" $out
2419	set err 1
2420	} else {
2421	set errmsg $out
2422	}
2423	donewait
2424	if {$expgui(showexptool) \|\| $err} {
2425	set msg "Please review the result from adding the atom(s)"
2426	if {$err} {append msg "\nIt appears an error occurred!"}
2427	ShowBigMessage $top $msg $errmsg OK "" $err
2428	}
2429	# set the powpref warning (2 = required)
2430	set expgui(needpowpref) 2
2431	set msg "A phase was replaced"
2432	if {[string first $msg $expgui(needpowpref_why)] == -1} {
2433	append expgui(needpowpref_why) "\t$msg\n"
2434	}
2435	destroy $top
2436	}
2437
2438
2439	proc replacephase3 {} {
2440	global expgui expmap
2441	# replace spacegroup and cell
2442	phaseinfo $phase spacegroup set $spg
2443	RecordMacroEntry "phaseinfo $phase spacegroup set [list $spg]" 0
2444	foreach val $cell var {a b c alpha beta gamma} {
2445	phaseinfo $phase $var set $val
2446	RecordMacroEntry "phaseinfo $phase $var set $val" 0
2447	}
2448	incr expgui(changed)
2449	# delete all atoms
2450	foreach i $expmap(atomlist_$phase) {
2451	EraseAtom $i $phase
2452	RecordMacroEntry "EraseAtom $i $phase" 0
2453	incr expgui(changed)
2454	}
2455	RecordMacroEntry "incr expgui(changed)" 0
2456	# write new atoms from table as input to exptool
2457	set errmsg [runAddAtoms $phase $atomlist]
2458	RecordMacroEntry "runAddAtoms $phase [list $atomlist]" 0
2459	}
2460
2461	proc sortAddAtoms {phase top sortvar} {
2462	global expgui
2463	set np $top.canvas.fr
2464	set validlist {}
2465	set invalidlist {}
2466	set row 0
2467	while {![catch {grid info $np.e[incr row]t}]} {
2468	set valid 1
2469	set line $row
2470	if !{$expgui(UseAtom$row)} {set valid 0}
2471	lappend line $expgui(UseAtom$row)
2472	if {[set type [string trim [$np.e${row}t get]]] == ""} {set valid 0}
2473	lappend line [string trim [$np.e${row}t get]]
2474	lappend line [string trim [$np.e${row}n get]]
2475	foreach i {x y z o u} {
2476	set tmp [string trim [$np.e${row}$i get]]
2477	lappend line $tmp
2478	if {$tmp == "" \|\| [catch {expr $tmp}]} {set valid 0}
2479	}
2480	if {$valid} {
2481	lappend validlist $line
2482	} else {
2483	lappend invalidlist $line
2484	}
2485	}
2486	switch $sortvar {
2487	type {set sortlist [lsort -index 2 -dictionary $validlist]}
2488	name {set sortlist [lsort -index 3 -dictionary $validlist]}
2489	x {set sortlist [lsort -index 4 -real $validlist]}
2490	y {set sortlist [lsort -index 5 -real $validlist]}
2491	z {set sortlist [lsort -index 6 -real $validlist]}
2492	occ {set sortlist [lsort -index 7 -real $validlist]}
2493	uiso {set sortlist [lsort -index 8 -real $validlist]}
2494	default {set sortlist $validlist}
2495	}
2496
2497	if {[llength $invalidlist] > 0} {append sortlist " $invalidlist"}
2498	set row 0
2499	foreach line $sortlist {
2500	incr row
2501	set expgui(UseAtom$row) [lindex $line 1]
2502	foreach item [lrange $line 2 end] \
2503	var {t n x y z o u} {
2504	$np.e${row}$var delete 0 end
2505	$np.e${row}$var insert end $item
2506	}
2507	}
2508	}
2509
2510	proc EditInstFile {"filename {}"} {
2511	global expgui
2512	# on the first call, load the commands
2513	if {[catch {
2514	if {[info procs instMakeWindow] == ""} {
2515	source [file join $expgui(scriptdir) instedit.tcl]
2516	}
2517	} errmsg]} {
2518	MyMessageBox -parent . -title "Load error" \
2519	-message "Unexpected error while sourcing file instedit.tcl: $errmsg" \
2520	-icon error
2521	}
2522	instMakeWindow $filename
2523	}
2524
2525	# load a list of Origin 1/2 space groups
2526	proc GetOrigin12List {} {
2527	# don't need to read the file twice
2528	if {[array names ::Origin1list] != ""} return
2529	set line {}
2530	set fp1 [open [file join $::expgui(scriptdir) spacegrp.ref] r]
2531	while {[lindex $line 1] != 230} {
2532	if {[gets $fp1 line] < 0} break
2533	}
2534	while {[gets $fp1 line] >= 0} {
2535	set key [string tolower [lindex $line 8]]
2536	regsub -all " " $key "" key
2537	regsub -- "-3" $key "3" key
2538	if {$key != ""} {
2539	# puts "$key -- [lindex $line 1] [lindex $line 8] [lindex $line 9]"
2540	set ::Origin1list($key) [lindex $line 9]
2541	}
2542	}
2543	close $fp1
2544	}
2545
2546	# get the shift to be added to origin 1 coordinates to obtain origin 2 settings
2547	proc GetOrigin1Shift {phase} {
2548	GetOrigin12List
2549	set spg [string tolower [phaseinfo $phase spacegroup]]
2550	regsub -all " " $spg "" spg
2551	regsub -- "-3" $spg "3" spg
2552	if {[catch {set shift $::Origin1list($spg)}]} {
2553	return ""
2554	} else {
2555	return $shift
2556	}
2557	}
2558
2559	proc XformAtoms2Origin2 {phase numberList w1 shift} {
2560	global expgui expmap
2561	set parent [winfo toplevel $w1]
2562	if {[llength $numberList] != [llength $expmap(atomlist_$phase)]} {
2563	# not all atoms were selected in phase -- do a sanity check
2564	set msg {You have selected only some atoms to be shifted. Do you want to shift all atoms or only the selected atoms?}
2565	set val [MyMessageBox -parent $parent -icon warning \
2566	-type "{Use all} {Use Selection}" -default "use all" \
2567	-title "Shift all" -message $msg]
2568	# puts "$phase $numberList $w1 $shift"
2569	if {$val == "use all"} {set numberList $expmap(atomlist_$phase)}
2570	}
2571	if {[lindex $expmap(phasetype) [expr {$phase - 1}]] == 4} {
2572	set cmd mmatominfo
2573	} else {
2574	set cmd atominfo
2575	}
2576	foreach atom $numberList {
2577	foreach v {x y z} vs $shift {
2578	set c [$cmd $phase $atom $v]
2579	$cmd $phase $atom $v set [expr {$c + $vs}]
2580	RecordMacroEntry "$cmd $phase $atom $v set [expr {$c + $vs}]" 0
2581	}
2582	incr expgui(changed)
2583	}
2584
2585	RecordMacroEntry "incr expgui(changed)" 0
2586	ResetMultiplicities $phase $parent
2587	SelectOnePhase $phase
2588	MyMessageBox -parent $parent -type OK -default ok -title "Shift applied" \
2589	-message "A shift of \"$shift\" has been added to coordinates of atoms [CompressList $numberList]"
2590	# UpdateAtomLine $numberList $phase
2591	destroy $parent
2592	}
2593
2594	# reset the site multiplicities using the EXPEDT program
2595	proc ResetMultiplicities {phase parent} {
2596	global expgui
2597	set errmsg [RunResetMultiplicities $phase]
2598	RecordMacroEntry "RunResetMultiplicities $phase" 0
2599
2600	if {$expgui(showexptool) \|\| $errmsg != ""} {
2601	if {$errmsg != ""} {
2602	set err 1
2603	append errmsg "\n" $expgui(exptoolout)
2604	} else {
2605	set err 0
2606	set errmsg $expgui(exptoolout)
2607	}
2608	set msg "Please review the result from listing the phase."
2609	if {$errmsg != ""} {append msg "\nIt appears an error occurred!"}
2610	ShowBigMessage $parent.msg $msg $errmsg OK "" $err
2611	}
2612	}
2613	proc RunResetMultiplicities {phase} {
2614	global expgui tcl_platform
2615	set input [open resetmult.inp w]
2616	puts $input "Y"
2617	puts $input "l a p $phase"
2618	puts $input "l"
2619	puts $input "x x x"
2620	puts $input "x"
2621	close $input
2622	# Save the current exp file
2623	savearchiveexp
2624	# disable the file changed monitor
2625	set expgui(expModifiedLast) 0
2626	set expnam [file root [file tail $expgui(expfile)]]
2627	set err [catch {
2628	if {$tcl_platform(platform) == "windows"} {
2629	exec [file join $expgui(gsasexe) expedt.exe] $expnam < resetmult.inp >& resetmult.out
2630	} else {
2631	exec [file join $expgui(gsasexe) expedt] $expnam < resetmult.inp >& resetmult.out
2632	}
2633	} errmsg]
2634	loadexp $expgui(expfile)
2635	set fp [open resetmult.out r]
2636	set out [read $fp]
2637	close $fp
2638	set expgui(exptoolout) $out
2639	catch {file delete resetmult.inp resetmult.out}
2640	if {$err} {
2641	return $errmsg
2642	} else {
2643	return ""
2644	}
2645	}
2646
2647	# default values
2648	set newhist(insttype) {}
2649	set newhist(dummy) 0
2650	set newhist(instfiletext) {}

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

Download in other formats: