source: trunk/addcmds.tcl @ 284

Last change on this file since 284 was 284, checked in by toby, 11 years ago

# on 2000/09/25 20:09:50, toby did:
Display a message returned by the import_*.tcl on the add/replace phase box
Note: not displayed if coordinates (only) are imported

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