source: trunk/addcmds.tcl @ 605

Last change on this file since 605 was 553, checked in by toby, 16 years ago

# on 2002/01/23 20:53:36, toby did:
fix bugs related to adding ValidateAtomsBox?
launch import (ImportPhase/ImportAtom?) when a import format is selected

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