source: trunk/addcmds.tcl @ 383

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

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