Context Navigation

source: trunk/addcmds.tcl @ 930

Last change on this file since 930 was 930, checked in by toby, 16 years ago
rcs:* properties removed
Property svn:keywords set to `Author Date Revision Id`
File size: 82.1 KB

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

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

Download in other formats: