source: trunk/addcmds.tcl @ 1166

Last change on this file since 1166 was 1166, checked in by toby, 9 years ago

bring sandbox changes over to main release

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