source: trunk/addcmds.tcl @ 413

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

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