Context Navigation

source: trunk/addcmds.tcl @ 1021

Last change on this file since 1021 was 992, checked in by toby, 15 years ago
changes for POWGEN: profile #<0; use data limits from prm file for TOF
Property svn:keywords set to `Author Date Revision Id`
File size: 83.8 KB

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

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

Download in other formats: