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