source: trunk/addcmds.tcl @ 874

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

# on 2006/03/29 03:47:44, toby did:
Allow use of d-min or Q-max when adding multiple histograms (IPNS request)

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