source: trunk/addcmds.tcl @ 394

Last change on this file since 394 was 394, checked in by toby, 14 years ago

# on 2001/05/23 20:06:32, toby did:
Use TOF-min for default when reading TOF banks
for TOF banks default inst parameter set to match the TOF bank
add definition for gsas environment variable (lc) before running exptool
  • Property rcs:author set to toby
  • Property rcs:date set to 2001/05/23 20:06:32
  • Property rcs:lines set to +29 -3
  • Property rcs:rev set to 1.20
  • Property rcs:state set to Exp
  • Property svn:keywords set to Author Date Revision Id
File size: 51.2 KB
Line 
1# $Id: addcmds.tcl 394 2009-12-04 23:05:26Z toby $
2
3proc MakeAddPhaseBox {} {
4    global expmap expgui
5
6    set expgui(coordList) {}
7    set nextphase ""
8    foreach p {1 2 3 4 5 6 7 8 9} {
9        if {[lsearch $expmap(phaselist) $p] == -1} {
10            set nextphase $p
11            break
12        }
13    }
14
15    # no more room
16    if {$nextphase == ""} {
17        MyMessageBox -parent . -title "Add Phase Error" \
18                -message "There are already 9 phases. You cannot add more." \
19                -icon error
20        return
21    }
22
23    set np .newphase
24    catch {destroy $np}
25    toplevel $np
26    bind $np <Key-F1> "MakeWWWHelp expgui2.html addphase"
27
28    grid [label $np.l1 -text "Adding phase #$nextphase"] \
29            -column 0 -row 0 -sticky w
30    grid [label $np.l2 -text "Phase title:"] -column 0 -row 1 
31    grid [entry $np.t1 -width 68] -column 1 -row 1 -columnspan 8
32    grid [label $np.l3 -text "Space Group:"] -column 0 -row 2 
33    grid [entry $np.t2 -width 12] -column 1 -row 2 
34    grid [frame $np.f -bd 4 -relief groove] -column 3 -row 2 -columnspan 8
35    set col -1
36    foreach i {a b c} {
37        grid [label $np.f.l1$i -text " $i "] -column [incr col] -row 1
38        grid [entry $np.f.e1$i -width 12] -column [incr col]  -row 1
39    }
40    set col -1
41    foreach i {a b g} {
42        grid [label $np.f.l2$i -text $i -font symbol] -column [incr col] -row 2
43        grid [entry $np.f.e2$i -width 12] -column [incr col]  -row 2
44        $np.f.e2$i insert 0 90.
45    }   
46   
47    grid [frame $np.bf] -row 3 -column 0 -columnspan 10 -sticky ew
48    grid [button $np.bf.b1 -text Add \
49            -command "addphase $np"] -column 2 -row 3
50    bind $np <Return> "addphase $np"
51    grid [button $np.bf.b2 -text Cancel \
52            -command "destroy $np"] -column 3 -row 3
53    grid columnconfig $np.bf 4 -weight 1
54    grid [button $np.bf.help -text Help -bg yellow \
55            -command "MakeWWWHelp expgui2.html addphase"] \
56            -column 4 -row 3
57
58    # get the input formats if not already defined
59    GetImportFormats
60    if {[llength $expgui(importFormatList)] > 0} {
61        grid [frame $np.bf.fr -bd 4 -relief groove] -column 5 -row 3
62        grid [button $np.bf.fr.b3 -text "Import phase from: " \
63                -command "ImportPhase \$expgui(importFormat) $np"] \
64                -column 0 -row 0 -sticky e
65        eval tk_optionMenu $np.bf.fr.b4 expgui(importFormat) \
66                $expgui(importFormatList)
67        grid $np.bf.fr.b4 -column 1 -row 0 -sticky w
68        grid rowconfig $np.bf.fr 0 -pad 10
69        grid columnconfig $np.bf.fr 0 -pad 10
70        grid columnconfig $np.bf.fr 1 -pad 10
71    }
72    wm title $np "add new phase"
73
74    # set grab, etc.
75    putontop $np
76   
77    tkwait window $np
78   
79    # fix grab...
80    afterputontop
81}
82
83proc addphase {np} {
84    global expgui expmap
85    # validate the input
86    set err {}
87    set title [$np.t1 get]
88    if {[string trim $title] == ""} {
89        append err "  Title cannot be blank\n"
90    }
91    set spg [$np.t2 get]
92    if {[string trim $spg] == ""} {
93        append err "  Space group cannot be blank\n"
94    }
95    foreach i {a b c} {
96        set cell($i) [$np.f.e1$i get]
97        if {[string trim $cell($i)] == ""} {
98            append err "  $i cannot be blank\n"
99        } elseif {[catch {expr $cell($i)}]} {
100            append err "  $i is not valid\n"
101        }
102    }
103
104    foreach i {a b g} lbl {alpha beta gamma} {
105        set cell($lbl) [$np.f.e2$i get]
106        if {[string trim $cell($lbl)] == ""} {
107            append err "  $lbl cannot be blank\n"
108        } elseif {[catch {expr $cell($lbl)}]} {
109            append err "  $lbl is not valid\n"
110        }
111    }
112
113    if {$err != ""} {
114        MyMessageBox -parent . -title "Add Phase Error" \
115                -message "The following error(s) were found in your input:\n$err" \
116                -icon error
117        set expgui(oldphaselist) -1
118        return
119    }
120
121    # check the space group
122    set fp [open spg.in w]
123    puts $fp "N"
124    puts $fp "N"
125    puts $fp $spg
126    puts $fp "Q"
127    close $fp
128    global tcl_platform
129    catch {
130        if {$tcl_platform(platform) == "windows"} {
131            exec [file join $expgui(gsasexe) spcgroup.exe] < spg.in >& spg.out
132        } else {
133            exec [file join $expgui(gsasexe) spcgroup] < spg.in >& spg.out
134        }
135    }
136    set fp [open spg.out r]
137    set out [read $fp]
138    close $fp
139    # attempt to parse out the output (fix up if parse did not work)
140    if {[regexp "space group symbol.*>(.*)Enter a new space group symbol" \
141            $out a b ] != 1} {set b $out}
142    if {[string first Error $b] != -1} {
143        # got an error, show it
144        ShowBigMessage \
145                 $np.error \
146                 "Error processing space group\nReview error message below" \
147                 $b
148        set expgui(oldphaselist) -1
149        return
150    } else {
151        # show the result and confirm
152        set opt [ShowBigMessage \
153                $np.check \
154                "Check the symmetry operators in the output below" \
155                $b \
156                {Continue Redo} ]
157        if {$opt > 1} {
158            set expgui(oldphaselist) -1
159            return
160        }
161    }
162    file delete spg.in spg.out
163   
164    # ok do it!
165    set fp [open exptool.in w]
166    puts $fp "P"
167    puts $fp $title
168    puts $fp $spg
169    puts $fp "$cell(a) $cell(b) $cell(c) $cell(alpha) $cell(beta) $cell(gamma)"
170    puts $fp "/"
171    close $fp
172    global tcl_platform
173    # Save the current exp file
174    savearchiveexp
175    # disable the file changed monitor
176    set expgui(expModifiedLast) 0
177    set expnam [file root [file tail $expgui(expfile)]]
178    # save the previous phase list
179    set expgui(oldphaselist) $expmap(phaselist)
180    catch {
181        if {$tcl_platform(platform) == "windows"} {
182            exec [file join $expgui(gsasexe) exptool.exe] $expnam \
183                    < exptool.in >& exptool.out
184        } else {
185            exec [file join $expgui(gsasexe) exptool] $expnam \
186                    < exptool.in >& exptool.out
187        }
188    } errmsg
189    # load the revised exp file
190    loadexp $expgui(expfile)
191    set fp [open exptool.out r]
192    set out [read $fp]
193    close $fp
194    destroy $np
195    if {$errmsg != ""} {
196        append errmsg "\n" $out
197    } else {
198        set errmsg $out
199    }
200    if {$expgui(showexptool)} {
201        ShowBigMessage \
202                $np \
203                "Please review the result from adding the phase" \
204                $errmsg
205    }
206    file delete exptool.in exptool.out
207    # now select the new phase
208    SelectOnePhase [lindex $expmap(phaselist) end]   
209}
210
211proc MakeAddHistBox {} {
212    global expmap newhist
213
214    # --> should check here if room for another histogram, but only texture
215    # folks will ever need that
216
217    set np .newhist
218    catch {destroy $np}
219    toplevel $np
220    bind $np <Key-F1> "MakeWWWHelp expgui3.html AddHist"
221
222    grid [label $np.l0 -text "Adding new histogram"] \
223            -column 0 -row 0 -sticky ew -columnspan 7
224    grid [label $np.l1 -text "Data file:"] -column 0 -row 1 
225    grid [label $np.t1 -textvariable newhist(rawfile) -bd 2 -relief ridge] \
226            -column 1 -row 1 -columnspan 3 -sticky ew
227    grid [button $np.b1 -text "Select File" \
228            -command "getrawfile $np" \
229            ] -column 4 -row 1
230
231    grid [label $np.lbank -text "Select bank" -anchor w] -column 1 -row 2 -sticky w
232    grid [frame $np.bank]  -column 2 -row 2 -columnspan 7 -sticky ew
233
234    grid [label $np.l2 -text "Instrument\nParameter file:"] -column 0 -row 3
235    grid [label $np.t2 -textvariable newhist(instfile) -bd 2 -relief ridge] \
236            -column 1 -row 3 -columnspan 3 -sticky ew
237    grid [button $np.b2 -text "Select File" \
238            -command "getinstfile $np" \
239            ] -column 4 -row 3
240
241    grid [label $np.lset -text "Select set" -anchor w] -column 1 -row 4 -sticky w
242    grid [frame $np.set]  -column 2 -row 4 -columnspan 7 -sticky ew
243
244    grid [label $np.l3 -text "Usable data limit:"] -column 0 -row 5 -rowspan 2 
245    grid [entry $np.e3 -width 12 -textvariable newhist(2tLimit) \
246            ] -column 1 -row 5 -rowspan 2 
247    grid [radiobutton $np.cb3 -text "D-min" -variable newhist(LimitMode) \
248            -value 0] -column 2 -row 5 -sticky w
249    grid [radiobutton $np.cb4 -text "TOF-min\n2-Theta Max" \
250            -variable newhist(LimitMode) -anchor w -justify l \
251            -value 1] -column 2 -row 6 -sticky w
252   
253    grid [frame $np.f6] -column 0 -row 7 -columnspan 5 -sticky ew
254    grid [button $np.f6.b6a -text Add \
255            -command "addhist $np"] -column 0 -row 0
256    bind $np <Return> "addhist $np"
257    grid [button $np.f6.b6b -text Cancel \
258            -command "destroy $np"] -column 1 -row 0
259    grid [button $np.f6.help -text Help -bg yellow \
260            -command "MakeWWWHelp expgui3.html AddHist"] \
261            -column 2 -row 0 -sticky e
262    grid columnconfigure $np.f6 2 -weight 1
263
264    grid [button $np.f6a -text "Run\nRAWPLOT" -command RunRawplot] \
265            -column 4 -row 5 -rowspan 2
266   
267    grid columnconfigure $np 3 -weight 1
268   
269    wm title $np "add new histogram"
270
271    if {[string trim $newhist(rawfile)] != {}} {
272        validaterawfile $np $newhist(rawfile)
273    }
274    if {[string trim $newhist(instfile)] != {}} {
275        validateinstfile $np $newhist(instfile)
276    }
277    set newhist(banknum) {}
278    set newhist(setnum) {}
279    #    for {set i 0} {$i<100} {incr i} {set newhist(bank$i) 0}
280    #    for {set i 0} {$i<100} {incr i} {set newhist(set$i) 0}
281
282    # set grab, etc.
283    putontop $np
284
285    tkwait window $np
286
287    # fix grab...
288    afterputontop
289}
290
291# convert a file to Win-95 direct access
292proc WinCvt {file win} {
293    global expgui
294    if ![file exists $file] {
295        MyMessageBox -parent $win -title "Convert Error" \
296                -message "File $file does not exist" -icon error
297        return
298    }
299
300    set tmpname "[file join [file dirname $file] tempfile.xxx]"
301    set oldname "[file rootname $file].org"
302    if [file exists $oldname] {
303        set ans [MyMessageBox -parent $win -title "OK to overwrite?" \
304                -message "File [file tail $oldname] exists in [file dirname $oldname]. OK to overwrite?" \
305                -icon question -type yesno -default yes]
306        if {$ans == "no"} return
307        catch {file delete $oldname}
308    }
309
310    if [catch {
311        set in [open $file r]
312        # needed to test under UNIX
313        set out [open $tmpname w]
314        fconfigure $out -translation crlf
315        set len [gets $in line]
316        if {$len > 160} {
317            # this is a UNIX file. Hope there are no control characters
318            set i 0
319            set j 79
320            while {$j < $len} {
321                puts $out [string range $line $i $j]
322                incr i 80
323                incr j 80
324            }
325        } else {
326            while {$len >= 0} {
327                append line "                                        "
328                append line "                                        "
329                set line [string range $line 0 79]
330                puts $out $line
331                set len [gets $in line]
332            }
333        }
334        close $in
335        close $out
336        file rename $file $oldname
337        file rename $tmpname $file
338    } errmsg] {
339        MyMessageBox -parent $win -title Notify \
340                -message "Error in conversion:\n$errmsg" -icon warning
341    }
342    return $file
343}
344
345proc getrawfile {np} {
346    global newhist tcl_platform
347    if {$tcl_platform(platform) == "windows"} {
348        set inp [
349        tk_getOpenFile -parent $np -initialfile $newhist(rawfile) -filetypes {
350            {"Data files" .GSAS} {"Data files" .GSA} 
351            {"Data files" .RAW}  {"All files" *}
352        }
353        ]
354    } else {
355        set inp [
356        tk_getOpenFile -parent $np -initialfile $newhist(rawfile) -filetypes {
357            {"Data files" .GSA*} {"Data files" .RAW} 
358            {"Data files" .gsa*} {"Data files" .raw} 
359            {"All files" *}
360        } 
361        ]
362    }
363    validaterawfile $np $inp
364}
365
366proc validaterawfile {np inp} {
367    global expgui newhist
368    if {$inp == ""} return
369    if [catch {set in [open $inp r]}] {
370        MyMessageBox -parent $np -title "Open error" \
371                -message "Unable to open file $inp" -icon error
372        return 
373    }
374    set newhist(banklist) {}
375    foreach child [winfo children $np.bank] {destroy $child}
376    # is this a properly formatted file?
377    # -- are lines the correct length & terminated with a CR-LF?   
378    fconfigure $in -translation lf
379    set i 0
380    while {[set len [gets $in line]] > 0} {
381        incr i
382        if {$len != 81 || [string range $line end end] != "\r"} {
383            set ans [MyMessageBox -parent $np -title "Convert?" \
384                    -message "File $inp is not in the correct format for GSAS.\nOK to convert?" \
385                    -icon warning -type {OK Quit} -default OK]
386            if {$ans == "ok"} {
387                # convert and reopen the file
388                close $in
389                WinCvt $inp $np
390                set i 0
391                set in [open $inp r]
392                fconfigure $in -translation lf
393                set line {}
394            } else {
395                return
396            }
397        }
398        # scan for BANK lines
399        if {[string first BANK $line] == 0} {
400            scan $line "BANK%d" num
401            lappend newhist(banklist) $num
402            # compute last point
403            set tmin 0
404            set tmax 0
405            catch {
406                scan $line "BANK%d%d%d%s%f%f" num nchan nrec rest start step
407                set tmin [expr $start/100.]
408                set tmax [expr ($start + $step*($nchan-1))/100.]
409            }
410            set newhist(tmin$num) $tmin
411            set newhist(tmax$num) $tmax
412        }
413        # check for "Instrument parameter file" line
414        if {$i == 2 && [string first "Instrument parameter" $line] == 0} {
415            validateinstfile $np \
416                    [file join [file dirname $inp] \
417                    [string trim [string range $line 26 end]]]
418        }
419    }
420    # were banks found?
421    if {$newhist(banklist) == ""} {
422        MyMessageBox -parent $np -title "Read error" \
423                -message "File $inp has no BANK lines.\nThis is not a valid GSAS data file." \
424                -icon warning
425        return
426    }
427    # don't use a full path unless needed
428    if {[pwd] == [file dirname $inp]} {
429        set newhist(rawfile) [file tail $inp]
430    } else {
431        set newhist(rawfile) $inp
432    }
433    set row 0
434    set col -1
435    foreach i $newhist(banklist) {
436        if {$col > 8} {
437            set col -1
438            incr row
439        }
440        grid [radiobutton $np.bank.$i -text $i -command SetTmax \
441                -variable newhist(banknum) -value $i] \
442                -column [incr col] -row $row -sticky w
443        # only 1 choice, so set it
444        if {[llength $newhist(banklist)] == 1} {
445            set newhist(banknum) $i
446            SetTmax
447        } else {
448            set newhist(2tLimit) {}
449            set newhist(LimitMode) {}
450        }
451    }
452}
453
454proc SetTmax {} {
455    global newhist
456    set num $newhist(banknum)
457    if {$newhist(insttype) == "TOF"} {
458        set newhist(2tLimit) $newhist(tmin$num)
459        if {[llength $newhist(banklist)] == $newhist(instbanks)} {
460            set newhist(setnum) $newhist(banknum)
461        }
462    } else {
463        set newhist(2tLimit) $newhist(tmax$num)
464    }
465    set newhist(LimitMode) 1
466
467}
468
469proc getinstfile {np} {
470    global newhist tcl_platform
471    if {$tcl_platform(platform) == "windows"} {
472        set inp [
473        tk_getOpenFile -parent $np -initialfile $newhist(instfile) -filetypes {
474            {"Inst files" .INST} {"Inst files" .INS} 
475            {"Inst files" .PRM} {"All files" *}
476        }
477        ]
478    } else {
479        set inp [
480        tk_getOpenFile -parent $np -initialfile $newhist(instfile) -filetypes {
481            {"Inst files" .INS*} {"Inst files" .ins*} 
482            {"Inst files" .PRM}  {"Inst files" .prm} 
483            {"All files" *}
484        }
485        ]
486    }
487    validateinstfile $np $inp
488}
489
490proc validateinstfile {np inp} {
491    global expgui newhist
492    if {$inp == ""} return
493    if [catch {set in [open $inp r]}] {
494        MyMessageBox -parent $np -title "Open error" \
495                -message "Unable to open file $inp" -icon error
496        return 
497    }
498    set newhist(instbanks) {}
499    foreach child [winfo children $np.set] {destroy $child}
500    # is this a properly formatted file?
501    # -- are lines the correct length & terminated with a CR-LF?   
502    fconfigure $in -translation lf
503    while {[set len [gets $in line]] > 0} {
504        if {$len != 81 || [string range $line end end] != "\r"} {
505            set ans [MyMessageBox -parent $np -title "Convert?" \
506                    -message "File $inp is not in the correct format for GSAS.\nOK to convert?" \
507                    -icon warning -type {OK Quit} -default OK]
508            if {$ans == "ok"} {
509                # convert and reopen the file
510                close $in
511                WinCvt $inp $np
512                set in [open $inp r]
513                fconfigure $in -translation lf
514                set line {}
515            } else {
516                return
517            }
518        }
519        # scan for the INS   BANK line
520        if {[string first "INS   BANK" $line] == 0} {
521            set newhist(instbanks) \
522                    [string trim [string range $line 12 end]]
523        }
524        # scan for the INS   BANK line
525        if {[string first "INS   HTYPE" $line] == 0} {
526            if {[string index [lindex $line 2] 2] == "T"} {
527                set newhist(insttype) TOF
528            } elseif {[string index [lindex $line 2] 2] == "E"} {
529                set newhist(insttype) ED
530            } else {
531                set newhist(insttype) CW
532            }
533        }
534    }
535    # were banks found?
536    if {$newhist(instbanks) == ""} {
537        MyMessageBox -parent $np -title "Read error" -message \
538                "File $inp has no \"INS   BANK\" line.\nThis is not a valid GSAS Instrument Parameter file." \
539                -icon warning
540        return
541    }
542    # don't use a full path unless needed
543    if {[pwd] == [file dirname $inp]} {
544        set newhist(instfile) [file tail $inp]
545    } else {
546        set newhist(instfile) $inp
547    }
548    set col -1
549    set row 0
550    for {set i 1} {$i <= $newhist(instbanks)} {incr i} {
551        if {$col > 8} {
552            set col -1
553            incr row
554        }
555        grid [radiobutton $np.set.$i -text $i \
556                -variable newhist(setnum) -value $i] \
557                -column [incr col] -row $row -sticky w
558
559        if {$newhist(instbanks) == 1} {set newhist(setnum) $i}
560    }
561}
562
563proc addhist {np} {
564    global expgui newhist tcl_platform
565    # validate the input
566    set err {}
567    if {[string trim $newhist(rawfile)] == ""} {
568        append err "  No data file specified\n"
569    }
570    if {[string trim $newhist(instfile)] == ""} {
571        append err "  No instrument parameter file specified\n"
572    }
573    if {[string trim $newhist(banknum)] == ""} {
574            append err "  Bank number must be specified\n"
575    } elseif {[catch {expr $newhist(banknum)}]} {
576            append err "  Bank number is not valid\n"
577    }
578    if {[string trim $newhist(setnum)] == ""} {
579        append err "  Parameter set number must be specified\n"
580    } elseif {[catch {expr $newhist(setnum)}]} {
581        append err "  Parameter set number is not valid\n"
582    }
583    if {[string trim $newhist(2tLimit)] == ""} {
584        append err "  2Theta/d-space limit must be specified\n"
585    } elseif {[catch {expr $newhist(2tLimit)}]} {
586        append err "  The 2Theta/d-space limit is not valid\n"
587    }
588    if {[string trim $newhist(LimitMode)] == ""} {
589        append err "  Please choose between either a 2Theta or d-space limit\n"
590    }
591
592    if {$err != ""} {
593        MyMessageBox -parent $np -title  "Add Histogram Error" \
594                -message "The following error(s) were found in your input:\n$err" \
595                -icon error -type ok -default ok \
596                -helplink "expgui3.html AddHistErr"
597        return
598    }
599
600    # ok do it!
601    set fp [open exptool.in w]
602    puts $fp "H"
603    if {$tcl_platform(platform) == "windows"} {
604        puts $fp [file attributes $newhist(rawfile) -shortname]
605        puts $fp [file attributes $newhist(instfile) -shortname]
606    } else {
607        puts $fp $newhist(rawfile)
608        puts $fp $newhist(instfile)
609    }
610    puts $fp $newhist(banknum)
611    puts $fp $newhist(setnum)
612    if {$newhist(LimitMode)} {
613        puts $fp "T"
614    } else {
615        puts $fp "D"
616    }
617    puts $fp "$newhist(2tLimit)"
618    puts $fp "/"
619    puts $fp "X"
620    puts $fp "X"
621    close $fp
622    global tcl_platform
623    # Save the current exp file
624    savearchiveexp
625    # disable the file changed monitor
626    set expgui(expModifiedLast) 0
627    set expnam [file root [file tail $expgui(expfile)]]
628    catch {
629        if {$tcl_platform(platform) == "windows"} {
630            exec [file join $expgui(gsasexe) exptool.exe] $expnam \
631                    < exptool.in >& exptool.out
632        } else {
633            exec [file join $expgui(gsasexe) exptool] $expnam \
634                    < exptool.in >& exptool.out
635        }
636    } errmsg
637    # load the revised exp file
638    loadexp $expgui(expfile)
639    set fp [open exptool.out r]
640    set out [read $fp]
641    close $fp
642    destroy $np
643    if {$errmsg != ""} {
644        append errmsg "\n" $out
645    } else {
646        set errmsg $out
647    }
648    if {$expgui(showexptool)} {
649        ShowBigMessage \
650                $np \
651                "Please review the result from adding the phase" \
652                $errmsg
653    }
654    file delete exptool.in exptool.out
655}
656
657proc RunRawplot {} {
658    global newhist tcl_platform
659    # for Windows put a message on top, in case file names must be shortened
660    if {$tcl_platform(platform) == "windows"} {
661        set f1 {}
662        catch {set f1 [file nativename \
663                    [file attributes $newhist(rawfile) -shortname]]}
664        set f2 {}
665        catch {set f2 [file nativename \
666                [file attributes $newhist(instfile) -shortname]]}
667        if {$f1 != "" || $f2 != ""} {
668            set msg "Note: input to RAWPLOT\n"
669            if {$f1 != ""} {append msg "data file: $f1\n"}
670            if {$f2 != ""} {append msg "instrument file: $f2"}
671            MyMessageBox -icon info -message $msg -parent .
672        }
673    }
674    # start RAWPLOT
675    runGSASprog rawplot 1
676}
677
678proc MakeAddAtomsBox {phase "atomlist {}"} {
679    global expmap expgui
680
681    # is there room for more atoms? Well, we will check this someday
682    if {$phase == ""} return
683    if {[llength $phase] != 1} return
684
685    set top .newatoms
686    catch {destroy $top}
687    toplevel $top
688    bind $top <Key-F1> "MakeWWWHelp expgui2.html addatoms"
689
690    grid [label $top.l1 -relief groove -bd 4 -anchor center\
691            -text "Adding atoms to phase #$phase"] \
692            -column 0 -row 0 \
693            -sticky we -columnspan 10
694   
695    grid [canvas $top.canvas \
696            -scrollregion {0 0 5000 500} -width 0 -height 250 \
697            -yscrollcommand "$top.scroll set"] \
698            -column 0 -row 2 -columnspan 4 -sticky nsew
699    grid columnconfigure $top 3 -weight 1
700    grid rowconfigure $top 2 -weight 1
701    grid rowconfigure $top 1 -pad 5
702    scrollbar $top.scroll \
703            -command "$top.canvas yview"
704    frame $top.canvas.fr
705    $top.canvas create window 0 0 -anchor nw -window $top.canvas.fr
706
707    set np $top.canvas.fr
708    set row 0
709    set col 0
710    grid [label $np.l_${row}0 -text "  #  "] -column $col -row $row
711    foreach i {Atom\ntype Name x y z Occ Uiso} \
712            var {type name x y z occ uiso} {
713        grid [button $np.l_${row}$i -text $i -padx 0 -pady 0 \
714                -command "sortAddAtoms $phase $top $var"] \
715                -column [incr col] -row $row -sticky nsew
716    }
717    grid [label $np.l_${row}Use -text Use\nFlag] -column [incr col] -row $row
718
719    set expgui(SetAddAtomsScroll) 0
720    set i [llength $atomlist]
721    if {$i == 0} {incr i}
722    for {set j 0} {$j < $i} {incr j} {
723        MakeAddAtomsRow $top
724    }
725    set row 0
726    foreach item $atomlist {
727        incr row
728        foreach val $item w {n x y z t o u} {
729            if {$val != ""} {
730                $np.e${row}$w delete 0 end
731                $np.e${row}$w insert end $val
732            }
733        }
734    }
735    bind $top <Configure> "SetAddAtomsScroll $top"
736    grid rowconfigure $top 3 -min 10
737    grid [button $top.b1 -text "Add Atoms"\
738            -command "addatom $phase $top"] -column 0 -row 5 -sticky w
739    bind $top <Return> "addatom $phase $top"
740    grid [button $top.b2 -text Cancel \
741            -command "destroy $top"] -column 1 -row 5 -sticky w
742    grid [button $top.help -text Help -bg yellow \
743            -command "MakeWWWHelp expgui2.html addatoms"] \
744            -column 0 -columnspan 2 -row 4
745
746    # get the input formats if not already defined
747    GetImportFormats
748    if {[llength $expgui(importFormatList)] > 0} {
749        grid [frame $top.fr -bd 4 -relief groove] \
750                -column 3 -row 5 -columnspan 2 -sticky e
751        grid [button $top.fr.b3 -text "Import atoms from: " \
752                -command "ImportAtoms \$expgui(importFormat) $top $phase"] \
753                -column 0 -row 0 -sticky e
754        eval tk_optionMenu $top.fr.b4 expgui(importFormat) \
755                $expgui(importFormatList)
756        grid $top.fr.b4 -column 1 -row 0 -sticky w
757        grid rowconfig $top.fr 0 -pad 10
758        grid columnconfig $top.fr 0 -pad 10
759        grid columnconfig $top.fr 1 -pad 10
760    }
761
762    grid [button $top.b3 -text  "More atom boxes" \
763            -command "MakeAddAtomsRow $top"] -column 3 \
764            -columnspan 2 -row 4 -sticky e
765   
766    wm title $top "add new atom"
767
768    # set grab, etc.
769    putontop $top
770
771    tkwait window $top
772
773    # fix grab...
774    afterputontop
775}
776
777proc MakeAddAtomsRow {top} {
778    set np $top.canvas.fr
779    set col -1
780    set row 1
781    # find an empty row
782    while {![catch {grid info $np.e${row}t}]} {incr row}
783    grid [label $np.e${row}num -text $row] -column [incr col]  -row $row
784    grid [entry $np.e${row}t -width 5] -column [incr col]  -row $row
785    grid [entry $np.e${row}n -width 8] -column [incr col]  -row $row
786    foreach i {x y z o u} {
787        grid [entry $np.e${row}$i -width 9] -column [incr col] -row $row
788    }
789    grid [checkbutton $np.e${row}use -variable expgui(UseAtom$row)] \
790            -column [incr col] -row $row
791    # default occupancy
792    $np.e${row}o delete 0 end
793    $np.e${row}o insert end 1.0
794    # default Uiso
795    $np.e${row}u delete 0 end
796    $np.e${row}u insert end 0.025
797    # default label
798    $np.e${row}n delete 0 end
799    $np.e${row}n insert end (default)
800    # use by default
801    $np.e${row}use select
802
803    SetAddAtomsScroll $top
804    return $row
805}
806
807proc SetAddAtomsScroll {top} {
808    global expgui
809    if $expgui(SetAddAtomsScroll) return
810    # prevent reentrance
811    set expgui(SetAddAtomsScroll) 1
812    update
813    set sizes [grid bbox $top.canvas.fr]
814    $top.canvas config -scrollregion $sizes -width [lindex $sizes 2]
815    # use the scroll for BIG atom lists
816    if {[lindex $sizes 3] > [winfo height $top.canvas]} {
817        grid $top.scroll -sticky ns -column 4 -row 2
818    } else {
819        grid forget $top.scroll 
820    }
821    update
822    set expgui(SetAddAtomsScroll) 0
823}
824
825proc addatom {phase top} {
826    global expgui env
827    set np $top.canvas.fr
828    set row 0
829    # loop over the defined rows
830    set err {}
831    set atomlist {}
832    set validatmtypes {
833        H H-1 H_1 H_2 H_3 HE HE_3 HE_4 LI LI+1 LI_6 LI_7 BE BE+2 B B_10
834        B_11 C CV C_12 C_13 N N_14 N_15 O O-1 O_16 O_17 O_18 F F-1 F_19 NE
835        NE_20 NE_21 NE_22 NA NA+1 NA_23 MG MG+2 MG_24 MG_25 MG_26 AL AL+3
836        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
837        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
838        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
839        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
840        FE+2 FE+3 FE_54 FE_56 FE_57 FE_58 CO CO+2 CO+3 CO_59 NI NI+2 NI+3
841        NI_58 NI_60 NI_61 NI_62 NI_64 CU CU+1 CU+2 CU_63 CU_65 ZN ZN+2 ZN_64
842        ZN_66 ZN_67 ZN_68 GA GA+3 GE GE+4 AS AS_75 SE BR BR-1 BR_79 BR_81 KR
843        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
844        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
845        AG+2 CD CD+2 CD_112 CD_113 CD_114 CD_116 IN IN+3 IN_113 IN_115 SN SN+2
846        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
847        CE+3 CE+4 PR PR+3 PR+4 PR_141 ND ND+3 PM PM+3 PM_147 SM SM+3 SM_152
848        SM_154 EU EU+2 EU+3 EU_153 GD GD+3 GD_160 TB TB+3 TB_159 DY DY+3 HO
849        HO+3 HO_165 ER ER+3 TM TM+3 TM_169 YB YB+2 YB+3 LU LU+3 HF HF+4 TA
850        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
851        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
852        PO_210 AT AT_210 RN RN_222 FR FR_223 RA RA+2 RA_226 AC AC+3 AC_227 TH
853        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
854        NP_237 PU PU+3 PU+4 PU+6 PU_239 PU_240 PU_242 AM AM_243 CM CM_244 BK
855        BK_247 CF CF_249
856    }
857    while {![catch {grid info $np.e[incr row]t}]} {
858        if !{$expgui(UseAtom$row)} continue
859        # ignore blank entries
860        set line {}
861        foreach i {t x y z} {
862            append line [string trim [$np.e${row}$i get]]
863        }
864        if {$line == ""} continue
865        # validate the input
866        if {[set type [string trim [$np.e${row}t get]]] == ""} {
867            append err "  line $row: No atom type specified\n"
868        }
869        if {[lsearch $validatmtypes [string toupper $type]] == -1} {
870            append err "  line $row: Atom type $type is invalid for GSAS\n"
871        }
872        set name [string trim [$np.e${row}n get]]
873        if {$name == "(default)"} {set name "/"}
874        if {$name == ""} {set name "/"}
875        foreach i {x y z o u} n {x y z Occ Uiso} {
876            if {[set $i [string trim [$np.e${row}$i get]]] == ""} {
877                append err "  line $row: No value specified for $n\n"
878            } elseif {[catch {expr [set $i]}]} {
879                append err "  line $row: The value for $n is invalid\n"
880            }
881        }
882        lappend atomlist "$type $x $y $z $o $name I $u"
883    }   
884    if {$err != ""} {
885        MyMessageBox -icon warning -message "Note Errors:\n$err" -parent $top
886        return
887    }
888    if {[llength $atomlist] == 0} {
889        MyMessageBox -icon warning -message "No atoms to load!" -parent $top
890        return
891    }
892    # ok add the atoms!
893    set fp [open exptool.in w]
894    puts $fp "A"
895    puts $fp $phase
896    # number of atoms
897    puts $fp [llength $atomlist]
898    foreach atomline $atomlist {
899        puts $fp $atomline
900    }
901    close $fp
902    # needed in UNIX
903    set env(ATOMDATA) [file join $expgui(gsasdir) data atmdata.dat]
904    set env(gsas) [file nativename $expgui(gsasdir)]
905    # needed in Windows
906    set env(GSAS) [file nativename $expgui(gsasdir)]
907
908    global tcl_platform
909    # Save the current exp file
910    savearchiveexp
911    # disable the file changed monitor
912    set expgui(expModifiedLast) 0
913    set expnam [file root [file tail $expgui(expfile)]]
914    catch {
915        if {$tcl_platform(platform) == "windows"} {
916            exec [file join $expgui(gsasexe) exptool.exe] $expnam \
917                    < exptool.in >& exptool.out
918        } else {
919            exec [file join $expgui(gsasexe) exptool] $expnam \
920                    < exptool.in >& exptool.out
921        }
922    } errmsg
923    # load the revised exp file
924    loadexp $expgui(expfile)
925    set fp [open exptool.out r]
926    set out [read $fp]
927    close $fp
928    destroy $top
929    if {$errmsg != ""} {
930        append errmsg "\n" $out
931    } else {
932        set errmsg $out
933    }
934    if {$expgui(showexptool)} {
935        ShowBigMessage \
936                $top \
937                "Please review the result from adding the atom(s)" \
938                $errmsg
939    }
940    file delete exptool.in exptool.out
941}
942
943#----------------------------------------------
944# commands to modify a group of selected atoms |
945#----------------------------------------------
946
947# make the dialog to choose an action
948proc MakeXformAtomsBox {phase} {
949    global expgui expmap
950    set numberList {}
951    set p $expgui(curPhase)
952    foreach AtomIndex $expgui(selectedatomlist) {
953        # get atom number & phase
954        set tuple [lindex $expmap(atomlistboxcontents) $AtomIndex]
955        lappend numberList [lindex $tuple 0]
956    }
957    if {$numberList == ""} return
958    if {[llength $numberList] > 1} {
959        set suffix s
960        set suffixy "ies"
961    } else {
962        set suffix ""
963        set suffixy "y"
964    }
965    set w .global
966    catch {destroy $w}
967    toplevel $w
968    wm title $w "Edit Atomic Parameter -- phase #$phase"
969    bind $w <Key-F1> "MakeWWWHelp expgui2.html xform"
970    # this needs to track by phase
971    grid [label $w.0 \
972            -text "Modifying atom${suffix} [CompressList $numberList] Phase $phase" \
973            -bg yellow -anchor center] -row 0 -column 0 -columnspan 10 \
974            -sticky nsew
975    grid rowconfigure $w 0 -pad 5
976    grid rowconfigure $w 1 -minsize 2
977
978    grid [TitleFrame $w.1 -bd 6 -relief groove -text "Modify coordinates"] \
979            -row 2 -column 0 -columnspan 10 -sticky news
980    set w1 [$w.1 getframe]
981    set row 0
982    foreach v {x y z} {
983        incr row
984        set col -1
985        grid [label $w1.l$v -text "new $v   =   "] -column [incr col] -row $row
986        foreach o {x y z} {
987            grid [entry $w1.e${v}${o} -width 6] -column [incr col] -row $row
988            $w1.e${v}${o} delete 0 end
989            if {$v == $o} {
990                $w1.e${v}${o} insert end "1.0"
991            } else {
992                $w1.e${v}${o} insert end "0."
993            }
994            grid [label $w1.p${v}${o} -text " $o  +  "] \
995                    -column [incr col] -row $row
996        }
997        grid [entry $w1.e${v} -width 6] -column [incr col] -row $row
998        $w1.e${v} delete 0 end
999        $w1.e${v} insert end "0."
1000    }
1001    grid [button $w1.do -text "Transform Coordinates" \
1002            -command "XformAtomsCoord $phase [list $numberList] $w1" \
1003            ] -row [incr row] -column 0 -columnspan 10
1004
1005    grid rowconfigure $w 3 -minsize 5
1006    grid [TitleFrame $w.4 -bd 6 -relief groove -text "Modify occupanc${suffixy}"] \
1007            -row 4 -column 0 -columnspan 10 -sticky news
1008    set w2 [$w.4 getframe]
1009    grid [label $w2.1 -text "Occupancy: "] -row 1 -column 0
1010    grid [entry $w2.e -width 10] -column 1 -row 1
1011    $w2.e delete 0 end
1012    $w2.e insert end 1.0
1013    grid columnconfigure $w2 2 -weight 1
1014    grid [button $w2.do -text "Set Occupanc${suffixy}" \
1015            -command "XformAtomsOcc $phase [list $numberList] $w2" \
1016            ] -row 2 -column 0 -columnspan 10
1017
1018    grid rowconfigure $w 5 -minsize 5
1019    grid [TitleFrame $w.6 -bd 6 -relief groove \
1020            -text "Modify Displacement Parameter$suffix"] \
1021            -row 6 -column 0 -columnspan 10 -sticky news
1022    set w2 [$w.6 getframe]
1023    grid [label $w2.1 -text "Uiso or Uequiv: "] -row 1 -column 0
1024    grid [entry $w2.e -width 10] -column 1 -row 1
1025    $w2.e delete 0 end
1026    $w2.e insert end 0.025
1027    grid columnconfigure $w2 2 -weight 1
1028    grid [button $w2.do -text "Set U" \
1029            -command "XformAtomsU $phase [list $numberList] $w2" \
1030            ] -row 2 -column 0 -columnspan 10
1031    grid [frame $w2.f] -row 3 -column 0 -columnspan 10
1032    grid [button $w2.f.iso -text "Set Isotropic" \
1033            -command "XformAtomsU $phase [list $numberList] iso" \
1034            ] -row 0 -column 0
1035    grid [button $w2.f.aniso -text "Set Anisotropic" \
1036            -command "XformAtomsU $phase [list $numberList] aniso" \
1037            ] -row 0 -column 1
1038
1039    grid rowconfigure $w 5 -minsize 5
1040    grid [TitleFrame $w.8 -bd 6 -relief groove \
1041            -text "Erase Atom$suffix"] \
1042            -row 8 -column 0 -columnspan 10 -sticky news
1043    set w2 [$w.8 getframe]
1044    grid [button $w2.do -text "Erase Atom${suffix}" \
1045            -command "EraseAtoms $phase [list $numberList] $w" \
1046            ] -row 2 -column 0 -columnspan 10
1047
1048
1049    grid rowconfigure $w 9 -minsize 5
1050    grid [frame $w.b] -row 10 -column 0 -columnspan 10 -sticky ew
1051    pack [button $w.b.3 -text Close -command "destroy $w"] -side left \
1052            -padx 5 -pady 5
1053    pack [button $w.b.help -text Help -bg yellow \
1054            -command "MakeWWWHelp expgui2.html xform"] -side right \
1055            -padx 5 -pady 5
1056    bind $w <Return> "destroy $w"
1057
1058    # force the window to stay on top
1059    putontop $w
1060    focus $w.b.3
1061    tkwait window $w
1062    afterputontop
1063    # if there are selected atoms, reset their display
1064    if {[llength $expgui(selectedatomlist)] != 0} editRecord
1065}
1066
1067# transform the coordinates
1068proc XformAtomsCoord {phase numberList w1} {
1069    global expgui
1070    # get the matrix
1071    foreach v {x y z} {
1072        foreach o {x y z} {
1073            set matrix(${v}${o}) [$w1.e${v}${o} get]
1074        }
1075        set matrix(${v}) [$w1.e${v} get]
1076    }
1077    foreach atom $numberList {
1078        foreach v {x y z} {
1079            set $v [atominfo $phase $atom $v]
1080        }
1081        foreach v {x y z} {
1082            set new$v $matrix(${v})
1083            foreach o {x y z} {
1084                set new$v [expr [set new$v] + $matrix(${v}${o})*[set $o]]
1085            }
1086            atominfo $phase $atom $v set [set new$v]
1087        }
1088        incr expgui(changed)
1089    }
1090    DisplayAllAtoms noreset
1091}
1092
1093# set the occupancies to a single value
1094proc XformAtomsOcc {phase numberList w2} {
1095    global expgui
1096    # get the value
1097    set val [$w2.e get]
1098    foreach atom $numberList {
1099        atominfo $phase $atom frac set $val
1100        incr expgui(changed)
1101    }
1102    DisplayAllAtoms noreset
1103}
1104
1105# transform Uiso or Uij; if anisotropic set Uequiv to Uij
1106proc XformAtomsU {phase numberList w2} {
1107    global expgui
1108    if {$w2 == "iso"} {
1109        foreach atom $numberList {
1110            if {[atominfo $phase $atom temptype] != "I"} {
1111                atominfo $phase $atom temptype set I
1112            }
1113        }
1114    } elseif {$w2 == "aniso"} {
1115        foreach atom $numberList {
1116            if {[atominfo $phase $atom temptype] == "I"} {
1117                atominfo $phase $atom temptype set A
1118            }
1119        }
1120    } else {
1121        # get the value
1122        set val [$w2.e get]
1123        foreach atom $numberList {
1124            if {[atominfo $phase $atom temptype] == "I"} {
1125                atominfo $phase $atom Uiso set $val
1126            } else {
1127                atominfo $phase $atom U11 set $val
1128                atominfo $phase $atom U22 set $val
1129                atominfo $phase $atom U33 set $val
1130                atominfo $phase $atom U12 set 0.0
1131                atominfo $phase $atom U13 set 0.0
1132                atominfo $phase $atom U23 set 0.0
1133            }
1134            incr expgui(changed)
1135        }
1136    }
1137    DisplayAllAtoms noreset
1138}
1139
1140# confirm and erase atoms
1141proc EraseAtoms {phase numberList w2} {
1142    global expgui
1143    if {[llength $numberList] <= 0} return
1144    # make a list of atoms
1145    foreach atom $numberList {
1146        append atomlist "\n\t$atom  [atominfo $phase $atom label]"
1147    }
1148    set msg "OK to remove the following [llength $numberList] atoms from phase $phase:$atomlist"
1149    set val [MyMessageBox -parent $w2 -type okcancel -icon warning \
1150            -default cancel -title "Confirm Erase" -message $msg]
1151    if {$val == "ok"} {
1152        foreach atom $numberList {
1153            EraseAtom $atom $phase
1154            incr expgui(changed)
1155        }
1156        mapexp
1157        DisplayAllAtoms
1158        destroy $w2
1159    }
1160}
1161
1162proc ImportPhase {format np} {
1163    global expgui
1164    foreach item $expgui(extensions_$format) {
1165        lappend typelist [list $format $item]
1166    }
1167    lappend typelist [list "All files" *]
1168    set file [tk_getOpenFile -parent $np -filetypes $typelist]
1169    if {![file exists $file]} return
1170    # read in the file
1171    set input [$expgui(proc_$format) $file]
1172    catch {
1173        $np.bf.b1 config -text "Continue" -command "addphase $np; AddAtomsList"
1174        bind $np <Return> "addphase $np; AddAtomsList"
1175    }
1176    catch {
1177        $np.t1 delete 0 end
1178        $np.t1 insert end "from $file"
1179    }
1180    $np.t2 delete 0 end
1181    $np.t2 insert end [lindex $input 0]
1182    foreach i {.e1a .e1b .e1c .e2a .e2b .e2g} val [lindex $input 1] {
1183        $np.f$i delete 0 end
1184        $np.f$i insert end $val
1185    }
1186    set expgui(coordList) [lindex $input 2]
1187    set msg [lindex $input 3]
1188    if {$msg != ""} {
1189        catch {destroy $np.msg}
1190        grid [label $np.msg -text $msg -fg red -anchor center -bd 4 -relief raised] \
1191                -column 0 -columnspan 99 -row 20 -sticky ew
1192    }
1193}
1194
1195proc ImportAtoms {format top phase} {
1196    global expgui
1197    foreach item $expgui(extensions_$format) {
1198        lappend typelist [list $format $item]
1199    }
1200    lappend typelist [list "All files" *]
1201    set file [tk_getOpenFile -parent $top -filetypes $typelist]
1202    if {![file exists $file]} return
1203    # read in the file
1204    set input [$expgui(proc_$format) $file]
1205    # add atoms to table
1206    foreach item [lindex $input 2] {
1207        set row [MakeAddAtomsRow $top]
1208        set np $top.canvas.fr
1209        foreach val $item w {n x y z t o u} {
1210            if {$val != ""} {
1211                $np.e${row}$w delete 0 end
1212                $np.e${row}$w insert end $val
1213            }
1214        }
1215    }
1216    # sort the atoms by number, so that empty entries are at the bottom
1217    sortAddAtoms $phase $top number
1218}
1219
1220proc AddAtomsList {} {
1221    global expgui expmap
1222    # skip if we aborted out of addphase
1223    if {$expgui(oldphaselist) == -1} return
1224    # find the new phase
1225    set phase {}
1226    foreach p $expmap(phaselist) {
1227        if {[lsearch $expgui(oldphaselist) $p] == -1} {
1228            set phase $p
1229            break
1230        }
1231    }
1232    if {$phase == ""} return
1233    MakeAddAtomsBox $phase $expgui(coordList)
1234}
1235
1236# get the input formats by sourcing files named import_*.tcl
1237proc GetImportFormats {} {
1238    global expgui tcl_platform
1239    # only needs to be done once
1240    if [catch {set expgui(importFormatList)}] {
1241        set filelist [glob -nocomplain [file join $expgui(scriptdir) import_*.tcl]]
1242        foreach file $filelist {
1243            source $file
1244            lappend expgui(importFormatList) $description
1245            if {$tcl_platform(platform) == "unix"} {
1246                set extensions "[string tolower $extensions] [string toupper $extensions]"
1247            }
1248            set expgui(extensions_$description) $extensions
1249            set expgui(proc_$description) $procname
1250        }
1251    }
1252}
1253
1254proc MakeReplacePhaseBox {} {
1255    global expmap expgui tcl_platform
1256
1257    set expgui(coordList) {}
1258    # ignore the command if no phase is selected
1259    foreach p {1 2 3 4 5 6 7 8 9} {
1260        if {[lsearch $expmap(phaselist) $expgui(curPhase)] == -1} {
1261            return
1262        }
1263    }
1264
1265    set top .newphase
1266    catch {destroy $top}
1267    toplevel $top
1268    bind $top <Key-F1> "MakeWWWHelp expgui2.html replacephase"
1269
1270    grid [label $top.l1 -text "Replacing phase #$expgui(curPhase)" \
1271            -bg yellow -anchor center] -column 0 -columnspan 8 -row 0 -sticky ew
1272    grid [label $top.l3a -text "Current Space Group: "] \
1273            -column 0 -row 2 -columnspan 2 -sticky e
1274    grid [label $top.l3b -text [phaseinfo $expgui(curPhase) spacegroup]\
1275            -bd 4 -relief groove] \
1276            -column 2 -row 2  -sticky ew
1277    grid [label $top.l4 -text "New Space Group: "] \
1278            -column 0 -row 3 -columnspan 2 -sticky e
1279    grid [entry $top.t2 -width 12] -column 2 -row 3 -sticky w
1280    grid [radiobutton $top.r1 -text "Reenter current atoms"\
1281            -variable expgui(DeleteAllAtoms) -value 0] \
1282            -column 1 -row 4 -columnspan 8 -sticky w
1283    grid [radiobutton $top.r2 -text "Delete current atoms" \
1284            -variable expgui(DeleteAllAtoms) -value 1] \
1285            -column 1 -row 5 -columnspan 8 -sticky w
1286   
1287    grid [frame $top.f -bd 4 -relief groove] \
1288            -column 3 -row 2 -columnspan 3 -rowspan 4
1289    set col -1
1290    foreach i {a b c} {
1291        grid [label $top.f.l1$i -text " $i "] -column [incr col] -row 1
1292        grid [entry $top.f.e1$i -width 12] -column [incr col]  -row 1
1293        $top.f.e1$i delete 0 end
1294        $top.f.e1$i insert 0 [phaseinfo $expgui(curPhase) $i]
1295    }
1296    set col -1
1297    foreach i {a b g} var {alpha beta gamma} {
1298        grid [label $top.f.l2$i -text $i -font symbol] -column [incr col] -row 2
1299        grid [entry $top.f.e2$i -width 12] -column [incr col]  -row 2
1300        $top.f.e2$i delete 0 end
1301        $top.f.e2$i insert 0 [phaseinfo $expgui(curPhase) $var]
1302    } 
1303
1304    grid [button $top.b1 -text Continue \
1305            -command "replacephase1 $top $expgui(curPhase)"] \
1306            -column 0 -row 6 -sticky w
1307    bind $top <Return> "replacephase1 $top $expgui(curPhase)"
1308    grid [button $top.b2 -text Cancel \
1309            -command "destroy $top"] -column 1 -row 6 -sticky w
1310    grid [button $top.help -text Help -bg yellow \
1311            -command "MakeWWWHelp expgui2.html replacephase"] \
1312            -column 2 -row 6
1313
1314    # get the input formats if not already defined
1315    GetImportFormats
1316    if {[llength $expgui(importFormatList)] > 0} {
1317        grid [frame $top.fr -bd 4 -relief groove] \
1318                -column 2 -row 6 -columnspan 8 -sticky e
1319        grid [button $top.fr.b3 -text "Import phase from: " \
1320                -command "ImportPhase \$expgui(importFormat) $top"] \
1321                -column 0 -row 0 -sticky e
1322        eval tk_optionMenu $top.fr.b4 expgui(importFormat) \
1323                $expgui(importFormatList)
1324        grid $top.fr.b4 -column 1 -row 0 -sticky w
1325        grid rowconfig $top.fr 0 -pad 10
1326        grid columnconfig $top.fr 0 -pad 10
1327        grid columnconfig $top.fr 1 -pad 10
1328#       grid columnconfig $top 4 -weight 1
1329        grid columnconfig $top 2 -weight 1
1330    }
1331   
1332    wm title $top "Replace phase $expgui(curPhase)"
1333
1334    # set grab, etc.
1335    putontop $top
1336
1337    tkwait window $top
1338
1339    # fix grab...
1340    afterputontop
1341}
1342
1343proc replacephase1 {top phase} {
1344    # validate cell & space group & save to pass
1345    global expgui expmap
1346    set expgui(SetAddAtomsScroll) 0
1347    # validate the input
1348    set err {}
1349    set spg [$top.t2 get]
1350    if {[string trim $spg] == ""} {
1351        append err "  Space group cannot be blank\n"
1352    }
1353    set cell {}
1354    foreach i {a b c a b g} lbl {a b c alpha beta gamma} n {1 1 1 2 2 2} {
1355        set $lbl [$top.f.e${n}$i get]
1356        if {[string trim [set $lbl]] == ""} {
1357            append err "  $lbl cannot be blank\n"
1358        } elseif {[catch {expr [set $lbl]}]} {
1359            append err "  [set $lbl] is not valid for $lbl\n"
1360        }
1361        lappend cell [set $lbl]
1362    }
1363
1364    if {$err != ""} {
1365        MyMessageBox -parent $top -title "Replace Phase Error" -icon warning \
1366                -message "The following error(s) were found in your input:\n$err" 
1367        return
1368    }
1369
1370    # check the space group
1371    set fp [open spg.in w]
1372    puts $fp "N"
1373    puts $fp "N"
1374    puts $fp $spg
1375    puts $fp "Q"
1376    close $fp
1377    global tcl_platform
1378    catch {
1379        if {$tcl_platform(platform) == "windows"} {
1380            exec [file join $expgui(gsasexe) spcgroup.exe] < spg.in >& spg.out
1381        } else {
1382            exec [file join $expgui(gsasexe) spcgroup] < spg.in >& spg.out
1383        }
1384    }
1385    set fp [open spg.out r]
1386    set out [read $fp]
1387    close $fp
1388    # attempt to parse out the output (fix up if parse did not work)
1389    if {[regexp "space group symbol.*>(.*)Enter a new space group symbol" \
1390            $out a b ] != 1} {set b $out}
1391    if {[string first Error $b] != -1} {
1392        # got an error, show it
1393        ShowBigMessage \
1394                 $top.error \
1395                 "Error processing space group\nReview error message below" \
1396                 $b
1397        return
1398    } else {
1399        # show the result and confirm
1400        set opt [ShowBigMessage \
1401                $top.check \
1402                "Check the symmetry operators in the output below" \
1403                $b \
1404                {Continue Redo} ]
1405        if {$opt > 1} return
1406    }
1407    file delete spg.in spg.out
1408    # draw coordinates box
1409    eval destroy [winfo children $top]
1410    grid [label $top.l1 -relief groove -bd 4 -anchor center\
1411            -text "Atom list for phase #$phase"] \
1412            -column 0 -row 0 \
1413            -sticky we -columnspan 10
1414    grid [canvas $top.canvas \
1415            -scrollregion {0 0 5000 500} -width 0 -height 250 \
1416            -yscrollcommand "$top.scroll set"] \
1417            -column 0 -row 2 -columnspan 4 -sticky nsew
1418    grid columnconfigure $top 3 -weight 1
1419    grid rowconfigure $top 2 -weight 1
1420    grid rowconfigure $top 1 -pad 5
1421    scrollbar $top.scroll \
1422            -command "$top.canvas yview"
1423    frame $top.canvas.fr
1424    $top.canvas create window 0 0 -anchor nw -window $top.canvas.fr
1425
1426    set np $top.canvas.fr
1427    set row 0
1428    set col 0
1429    grid [label $np.l_${row}0 -text "  #  "] -column $col -row $row
1430    foreach i {Atom\ntype Name x y z Occ Uiso} \
1431            var {type name x y z occ uiso} {
1432        grid [button $np.l_${row}$i -text $i -padx 0 -pady 0 \
1433                -command "sortAddAtoms $phase $top $var"] \
1434                -column [incr col] -row $row -sticky nsew
1435    }
1436    grid [label $np.l_${row}Use -text Use\nFlag] -column [incr col] -row $row
1437
1438    # add the old atoms, if appropriate
1439    if {!$expgui(DeleteAllAtoms)} {
1440        # loop over all atoms
1441        foreach atom $expmap(atomlist_$phase) {
1442            set row [MakeAddAtomsRow $top]
1443            # add all atoms in the current phase to the list
1444            foreach w {n x y z t o} var {label x y z type frac} {
1445                $np.e${row}$w delete 0 end
1446                $np.e${row}$w insert end [atominfo $phase $atom $var]
1447            }
1448            $np.e${row}u delete 0 end
1449            if {[atominfo $phase $atom temptype] == "I"} {
1450                $np.e${row}u insert end [atominfo $phase $atom Uiso]
1451            } else {
1452                $np.e${row}u insert end [expr ( \
1453                        [atominfo $phase $atom U11] + \
1454                        [atominfo $phase $atom U22] + \
1455                        [atominfo $phase $atom U33]) / 3.]
1456            }
1457        }
1458    }
1459
1460    # add coordinates that have been read in, if any
1461    foreach item $expgui(coordList) {
1462        set row [MakeAddAtomsRow $top]
1463        foreach val $item w {n x y z t o u} {
1464            if {$val != ""} {
1465                $np.e${row}$w delete 0 end
1466                $np.e${row}$w insert end $val
1467            }
1468        }
1469    }
1470    # a blank spot in the table
1471    MakeAddAtomsRow $top
1472
1473    bind $top <Configure> "SetAddAtomsScroll $top"
1474    grid rowconfigure $top 3 -min 10
1475    grid [button $top.b1 -text "Continue"\
1476            -command "replacephase2 $phase $top [list $spg] [list $cell]"] \
1477            -column 0 -row 5 -sticky w
1478    bind $top <Return> "replacephase2 $phase $top [list $spg] [list $cell]"
1479    grid [button $top.b2 -text Cancel \
1480            -command "destroy $top"] -column 1 -row 5 -sticky w
1481    if {[llength $expgui(importFormatList)] > 0} {
1482        grid [frame $top.fr -bd 4 -relief groove] \
1483                -column 3 -row 5 -columnspan 2 -sticky e
1484        grid [button $top.fr.b3 -text "Import atoms from: " \
1485                -command "ImportAtoms \$expgui(importFormat) $top $phase"] \
1486                -column 0 -row 0 -sticky e
1487        eval tk_optionMenu $top.fr.b4 expgui(importFormat) \
1488                $expgui(importFormatList)
1489        grid $top.fr.b4 -column 1 -row 0 -sticky w
1490        grid rowconfig $top.fr 0 -pad 10
1491        grid columnconfig $top.fr 0 -pad 10
1492        grid columnconfig $top.fr 1 -pad 10
1493    }
1494
1495    grid [button $top.b3 -text  "More atom boxes" \
1496            -command "MakeAddAtomsRow $top"] -column 3 \
1497            -columnspan 2 -row 4 -sticky e
1498   
1499    wm title $top "Replacing phase: Enter atoms"
1500    SetAddAtomsScroll $top
1501
1502    # fix grab for old window
1503    afterputontop
1504    # set grab, etc.
1505    putontop $top
1506}
1507
1508proc replacephase2 {phase top spg cell} {
1509    global expgui expmap env
1510    # validate coordinates
1511    set np $top.canvas.fr
1512    set row 0
1513    # loop over the defined rows
1514    set err {}
1515    set atomlist {}
1516    set validatmtypes {
1517        H H-1 H_1 H_2 H_3 HE HE_3 HE_4 LI LI+1 LI_6 LI_7 BE BE+2 B B_10
1518        B_11 C CV C_12 C_13 N N_14 N_15 O O-1 O_16 O_17 O_18 F F-1 F_19 NE
1519        NE_20 NE_21 NE_22 NA NA+1 NA_23 MG MG+2 MG_24 MG_25 MG_26 AL AL+3
1520        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
1521        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
1522        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
1523        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
1524        FE+2 FE+3 FE_54 FE_56 FE_57 FE_58 CO CO+2 CO+3 CO_59 NI NI+2 NI+3
1525        NI_58 NI_60 NI_61 NI_62 NI_64 CU CU+1 CU+2 CU_63 CU_65 ZN ZN+2 ZN_64
1526        ZN_66 ZN_67 ZN_68 GA GA+3 GE GE+4 AS AS_75 SE BR BR-1 BR_79 BR_81 KR
1527        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
1528        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
1529        AG+2 CD CD+2 CD_112 CD_113 CD_114 CD_116 IN IN+3 IN_113 IN_115 SN SN+2
1530        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
1531        CE+3 CE+4 PR PR+3 PR+4 PR_141 ND ND+3 PM PM+3 PM_147 SM SM+3 SM_152
1532        SM_154 EU EU+2 EU+3 EU_153 GD GD+3 GD_160 TB TB+3 TB_159 DY DY+3 HO
1533        HO+3 HO_165 ER ER+3 TM TM+3 TM_169 YB YB+2 YB+3 LU LU+3 HF HF+4 TA
1534        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
1535        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
1536        PO_210 AT AT_210 RN RN_222 FR FR_223 RA RA+2 RA_226 AC AC+3 AC_227 TH
1537        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
1538        NP_237 PU PU+3 PU+4 PU+6 PU_239 PU_240 PU_242 AM AM_243 CM CM_244 BK
1539        BK_247 CF CF_249
1540    }
1541    while {![catch {grid info $np.e[incr row]t}]} {
1542        if !{$expgui(UseAtom$row)} continue
1543        # ignore blank entries
1544        set line {}
1545        foreach i {t x y z} {
1546            append line [string trim [$np.e${row}$i get]]
1547        }
1548        if {$line == ""} continue
1549        # validate the input
1550        if {[set type [string trim [$np.e${row}t get]]] == ""} {
1551            append err "  line $row: No atom type specified\n"
1552        }
1553        if {[lsearch $validatmtypes [string toupper $type]] == -1} {
1554            append err "  line $row: Atom type $type is invalid for GSAS\n"
1555        }
1556        set name [string trim [$np.e${row}n get]]
1557        if {$name == "(default)"} {set name "/"}
1558        if {$name == ""} {set name "/"}
1559        foreach i {x y z o u} n {x y z Occ Uiso} {
1560            if {[set $i [string trim [$np.e${row}$i get]]] == ""} {
1561                append err "  line $row: No value specified for $n\n"
1562            } elseif {[catch {expr [set $i]}]} {
1563                append err "  line $row: The value for $n is invalid\n"
1564            }
1565        }
1566        lappend atomlist "$type $x $y $z $o $name I $u"
1567    }   
1568    if {$err != ""} {
1569        MyMessageBox -icon warning -message "Note Errors:\n$err" -parent $top
1570        return
1571    }
1572    if {[llength $atomlist] == 0} {
1573        MyMessageBox -icon warning -message "No atoms to load!" -parent $top
1574        return
1575    }
1576
1577    pleasewait "updating phase"
1578    # replace spacegroup and cell
1579    phaseinfo $phase spacegroup set $spg
1580    foreach val $cell var {a b c alpha beta gamma} {
1581        phaseinfo $phase $var set $val
1582    }
1583    # delete all atoms
1584    foreach i $expmap(atomlist_$phase) {
1585        EraseAtom $i $phase
1586    }
1587    incr expgui(changed) 8
1588    # write new atoms from table as input to exptool
1589    set fp [open exptool.in w]
1590    puts $fp "A"
1591    puts $fp $phase
1592    # number of atoms
1593    puts $fp [llength $atomlist]
1594    foreach atomline $atomlist {
1595        puts $fp $atomline
1596    }
1597    close $fp
1598    # needed in UNIX
1599    set env(ATOMDATA) [file join $expgui(gsasdir) data atmdata.dat]
1600    set env(gsas) [file nativename $expgui(gsasdir)]
1601    # needed in Windows
1602    set env(GSAS) [file nativename $expgui(gsasdir)]
1603
1604    global tcl_platform
1605    # Save the current exp file
1606    savearchiveexp
1607    # disable the file changed monitor
1608    set expgui(expModifiedLast) 0
1609    set expnam [file root [file tail $expgui(expfile)]]
1610    catch {
1611        if {$tcl_platform(platform) == "windows"} {
1612            exec [file join $expgui(gsasexe) exptool.exe] $expnam \
1613                    < exptool.in >& exptool.out
1614        } else {
1615            exec [file join $expgui(gsasexe) exptool] $expnam \
1616                    < exptool.in >& exptool.out
1617        }
1618    } errmsg
1619    # load the revised exp file
1620    loadexp $expgui(expfile)
1621    set fp [open exptool.out r]
1622    set out [read $fp]
1623    close $fp
1624    if {$errmsg != ""} {
1625        append errmsg "\n" $out
1626    } else {
1627        set errmsg $out
1628    }
1629    donewait 
1630    if {$expgui(showexptool)} {
1631        ShowBigMessage \
1632                $top \
1633                "Please review the result from adding the atom(s)" \
1634                $errmsg
1635    }
1636    file delete exptool.in exptool.out
1637    destroy $top
1638}
1639
1640proc sortAddAtoms {phase top sortvar} {
1641    global expgui
1642    set np $top.canvas.fr
1643    set validlist {}
1644    set invalidlist {}
1645    set row 0
1646    while {![catch {grid info $np.e[incr row]t}]} {
1647        set valid 1
1648        set line $row
1649        if !{$expgui(UseAtom$row)} {set valid 0}
1650        lappend line $expgui(UseAtom$row)
1651        if {[set type [string trim [$np.e${row}t get]]] == ""} {set valid 0}
1652        lappend line [string trim [$np.e${row}t get]]
1653        lappend line [string trim [$np.e${row}n get]]
1654        foreach i {x y z o u} {
1655            set tmp [string trim [$np.e${row}$i get]]
1656            lappend line $tmp
1657            if {$tmp == "" || [catch {expr $tmp}]} {set valid 0}
1658        }
1659        if {$valid} {
1660            lappend validlist $line
1661        } else {
1662            lappend invalidlist $line
1663        }
1664    }
1665    switch $sortvar {
1666        type {set sortlist [lsort -index 2 -dictionary $validlist]}
1667        name {set sortlist [lsort -index 3 -dictionary $validlist]}
1668        x {set sortlist [lsort -index 4 -real $validlist]}
1669        y {set sortlist [lsort -index 5 -real $validlist]}
1670        z {set sortlist [lsort -index 6 -real $validlist]}
1671        occ {set sortlist [lsort -index 7 -real $validlist]}
1672        uiso  {set sortlist [lsort -index 8 -real $validlist]}
1673        default {set sortlist $validlist}
1674    }
1675
1676    if {[llength $invalidlist] > 0} {append sortlist " $invalidlist"}
1677    set row 0
1678    foreach line $sortlist {
1679        incr row
1680        set expgui(UseAtom$row) [lindex $line 1]
1681        foreach item [lrange $line 2 end] \
1682                var {t n x y z o u} {
1683            $np.e${row}$var delete 0 end
1684            $np.e${row}$var insert end $item
1685        }
1686    }
1687}
1688# default
1689set newhist(insttype) CW
Note: See TracBrowser for help on using the repository browser.