source: trunk/addcmds.tcl @ 668

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

# on 2003/04/10 21:59:03, toby did:
leave filenames up for rawplot
set tmin properly for TOF
show text for bank selected
add Qmax option
add "run powpref" warning

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