source: trunk/addcmds.tcl @ 458

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

# on 2001/10/14 05:36:29, toby did:
blank out dummy histogram ranges until a set is selected

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