source: trunk/addcmds.tcl @ 379

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

# on 2001/04/16 21:25:33, toby did:
Add atom sort feature

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