source: trunk/addcmds.tcl @ 1116

Last change on this file since 1116 was 1116, checked in by toby, 10 years ago

fix Ashfia's tmin problem again

  • Property svn:keywords set to Author Date Revision Id
File size: 85.3 KB
Line 
1# $Id: addcmds.tcl 1116 2011-03-02 15:29:09Z 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    # is a instrument parameter file loaded? If not, try again later
712    if {[string trim $newhist(instfile)] == ""} return
713    # get data bank number, test if valid
714    set num $newhist(banknum)
715    if {[catch {expr $num}]} {return}
716    if {$newhist(insttype) == "TOF"} {
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        puts $fp [file attributes $rawfile -shortname]
940        puts $fp [file attributes $instfile -shortname]
941    } else {
942        puts $fp $rawfile
943        puts $fp $instfile
944    }
945    puts $fp $banknum
946    puts $fp $setnum
947    puts $fp $mode
948    puts $fp "$value"
949    puts $fp "/"
950    puts $fp "X"
951    puts $fp "X"
952    close $fp
953    # Save the current exp file
954    savearchiveexp
955    # disable the file changed monitor
956    set expgui(expModifiedLast) 0
957    set expnam [file root [file tail $expgui(expfile)]]
958    set err [catch {
959        if {$tcl_platform(platform) == "windows"} {
960            exec [file join $expgui(gsasexe) exptool.exe] $expnam \
961                    < exptool.in >& exptool.out
962        } else {
963            exec [file join $expgui(gsasexe) exptool] $expnam \
964                    < exptool.in >& exptool.out
965        }
966    } errmsg]
967    # load the revised exp file
968    set oldpowderlist $expmap(powderlist)
969    loadexp $expgui(expfile)
970    if {[llength $oldpowderlist] == [llength $expmap(powderlist)]} {
971        append errmsg "\nNo histogram added"
972        set err 1
973    }
974    set fp [open exptool.out r]
975    set expgui(exptoolout) [read $fp]
976    close $fp
977    catch {file delete exptool.in exptool.out}
978    if {$err} {
979        return $errmsg
980    } else {
981        return ""
982    }
983}
984
985proc RunRawplot {parent} {
986    global newhist tcl_platform
987    set f1 $newhist(rawfile)
988    set f2 $newhist(instfile)
989    # for Windows put a message on top, in case file names must be shortened
990    if {$tcl_platform(platform) == "windows"} {
991        catch {set f1 [file nativename \
992                    [file attributes $newhist(rawfile) -shortname]]}
993        catch {set f2 [file nativename \
994                [file attributes $newhist(instfile) -shortname]]}
995    }
996    if {$f1 != "" || $f2 != ""} {
997        #set msg "Note: input to RAWPLOT\n"
998        #if {$f1 != ""} {append msg "data file: $f1\n"}
999        #if {$f2 != ""} {append msg "instrument file: $f2"}
1000        catch {toplevel $parent.msg}
1001        catch {eval destroy [winfo children $parent.msg]}
1002        wm title $parent.msg "File names"
1003        grid [label $parent.msg.1 \
1004                -text "File names to be input to RAWPLOT" \
1005                -justify center -anchor center] \
1006                -column 0 -row 0 -columnspan 2
1007        if {$f1 != ""} {
1008            grid [label $parent.msg.2a \
1009                    -text "Raw histogram: $f1" \
1010                    -justify center -anchor e] \
1011                    -column 0 -row 1
1012            grid [button $parent.msg.2b \
1013                    -command "clipboard clear; clipboard append $f1" \
1014                    -text "put name\nin clipboard"] \
1015                    -column 1 -row 1
1016        }           
1017        if {$f2 != ""} {
1018            grid [label $parent.msg.3a \
1019                    -text "Raw histogram: $f2" \
1020                    -justify center -anchor e] \
1021                    -column 0 -row 2
1022            grid [button $parent.msg.3b \
1023                    -command "clipboard clear; clipboard append $f2" \
1024                    -text "put name\nin clipboard"] \
1025                    -column 1 -row 2
1026        }           
1027        grid [button $parent.msg.4 \
1028                -command "destroy $parent.msg" \
1029                -text "Close"] \
1030                -column 0 -columnspan 2 -row 9
1031    }
1032    # start RAWPLOT
1033    runGSASprog rawplot 1
1034    if {[winfo exists $parent.msg]} {raise $parent.msg}
1035    update
1036}
1037#--- Respond to the setting of the bank # for the Instrument parameter file.
1038proc PostInstBankopts {np} {
1039    global newhist
1040    if {$newhist(dummy)} {
1041        trace variable newhist(tmin) w "ValidateDummyHist $np"
1042        trace variable newhist(tmax) w "ValidateDummyHist $np"
1043        trace variable newhist(tstep) w "ValidateDummyHist $np"
1044        foreach w {l1 t1 lbank} {
1045            $np.$w config -fg grey
1046        }
1047        $np.d1.m1 config -text {}
1048        $np.d1.m2 config -text {}
1049        $np.b1 config -state disabled
1050        grid forget $np.l3 $np.e3 $np.cb3 $np.cb4 $np.cb5 $np.bank $np.f6a
1051        grid $np.dl1 -column 0 -row 18
1052        grid $np.d1 -column 1 -row 18 -rowspan 2 -columnspan 4 -sticky e
1053        grid $np.dl3 -column 0 -columnspan 99 -row 20 -sticky ew
1054        if {$newhist(insttype) == "TOF"} {
1055            $np.dl1 config -text "Data range:\n(TOF)"
1056            $np.d1.lu config -text millisec
1057            grid $np.dl2 -column 0 -row 19
1058            catch {
1059                set s $newhist(setnum)
1060                foreach {x tmin tmax x} $newhist(inst${s}ITYP) {}
1061                $np.d1.m1 config -text $tmin
1062                $np.d1.m2 config -text $tmax
1063            }
1064        } elseif {[lindex $newhist(insttype) 0] == "CW"} {
1065            $np.dl1 config -text "Data range:\n(2Theta)"
1066            $np.d1.lu config -text degrees
1067            #grid forget $np.dl2
1068            $np.d1.m1 config -text >0.
1069            $np.d1.m2 config -text <180.
1070        } elseif {$newhist(insttype) == "ED"} {
1071            $np.dl1 config -text "Data range:\n(Energy)"
1072            $np.d1.lu config -text KeV
1073            $np.d1.m1 config -text 1.
1074            $np.d1.m2 config -text 200.
1075            grid $np.dl2 -column 0 -row 19
1076        } else {
1077            $np.dl1 config -text "No file\nselected"
1078            $np.d1.lu config -text {}
1079        }
1080    } else {
1081        foreach var {tmin tmax tstep} {
1082            foreach v [ trace vinfo newhist($var)] {
1083                eval trace vdelete newhist($var) $v
1084            }
1085        }
1086        grid forget $np.dl1 $np.d1 $np.dl2 $np.dl3
1087        foreach w {l1 t1 lbank} {
1088            $np.$w config -fg black
1089        }
1090        $np.b1 config -state normal
1091        grid $np.bank -column 2 -row 3 -columnspan 7 -sticky ew
1092        grid $np.f6a -column 4 -row 18 -rowspan 3
1093        grid $np.l3 -column 0 -row 18 -rowspan 3
1094        grid $np.e3 -column 1 -row 18 -rowspan 3 
1095        grid $np.cb3 -column 2 -row 18 -sticky w
1096        grid $np.cb4 -column 2 -row 20 -sticky w
1097        grid $np.cb5 -column 2 -row 19 -sticky w
1098        SetTmax
1099    }
1100}
1101
1102proc ValidateDummyHist {np args} {
1103    # validate input
1104    global newhist
1105    set msg {}
1106    $np.dl3 config -text "\n"
1107    foreach e {e1 e2 e3} v {tmin tmax tstep} {
1108        if [catch {expr $newhist($v)}] {
1109            $np.d1.$e config -fg red
1110            append msg "Value of $newhist($v) is invalid for $v\n"
1111        } else {
1112            $np.d1.$e config -fg black
1113        }
1114    }
1115    if {[catch {expr $newhist(setnum)}]} {
1116        append msg "An instrument file bank number must be selected\n"
1117    } elseif {$newhist(setnum) <= 0 || \
1118            $newhist(setnum) > $newhist(instbanks)} {
1119        append msg "An invalid instrument file bank has been selected\n"
1120    }
1121
1122    if {$msg != ""} {return $msg}
1123
1124    if {$newhist(tmax) <= $newhist(tmin)} {
1125        $np.d1.e1 config -fg red
1126        $np.d1.e2 config -fg red
1127        return "Tmax <= Tmin\n"
1128    }
1129
1130
1131    set dmin -1
1132    set dmax -1
1133    if {$newhist(insttype) == "TOF"} {
1134        catch {
1135            set s $newhist(setnum)
1136            foreach {x tmin tmax x} $newhist(inst${s}ITYP) {}
1137            if {$newhist(tmin) <$tmin } {
1138                $np.d1.e1 config -fg red
1139                append msg "Min value of $newhist(tmin) msec is invalid.\n"
1140            }
1141            if {$newhist(tmax) >$tmax } {
1142                $np.d1.e2 config -fg red
1143                append msg "Max value of $newhist(tmax) msec is invalid.\n"
1144            }
1145            set s $newhist(setnum)
1146            set dmin [expr {1000. * $newhist(tmin) / \
1147                    [lindex $newhist(inst${s}ICONS) 0]}]
1148            set dmax [expr {1000. * $newhist(tmax) / \
1149                    [lindex $newhist(inst${s}ICONS) 0]}]
1150        }
1151    } elseif {[lindex $newhist(insttype) 0] == "CW"} {
1152        if {$newhist(tmin) <= 0 } {
1153            $np.d1.e1 config -fg red
1154            append msg "Min value of $newhist(tmin) degrees is invalid.\n"
1155        }
1156        if {$newhist(tmax) >=180 } {
1157            $np.d1.e2 config -fg red
1158            append msg "Max value of $newhist(tmax) degrees is invalid.\n"
1159        }
1160        catch {
1161            set s $newhist(setnum)
1162            set dmin [expr {[lindex $newhist(inst${s}ICONS) 0]\
1163                    * 0.5 / sin(acos(0.)*$newhist(tmax)/180.)}]
1164            set dmax [expr {[lindex $newhist(inst${s}ICONS) 0]\
1165                    * 0.5 / sin(acos(0.)*$newhist(tmin)/180.)}]
1166        }
1167    } else {
1168        if {$newhist(tmin) <1 } {
1169            $np.d1.e1 config -fg red
1170            append msg "Min value of $newhist(tmin) KeV is invalid.\n"
1171        }
1172        if {$newhist(tmax) >200 } {
1173            $np.d1.e2 config -fg red
1174            append msg "Max value of $newhist(tmax) KeV is invalid.\n"
1175        }
1176        catch {
1177            set s $newhist(setnum)
1178            set ang [lindex $newhist(inst${s}ICONS) 0]
1179            set dmin [expr {12.398/ (2.0*sin($ang*acos(0.)/180) * \
1180                    $newhist(tmax))}]
1181            set dmax [expr {12.398/ (2.0*sin($ang*acos(0.)/180) * \
1182                    $newhist(tmin))}]
1183        }
1184    }
1185    if {$msg != ""} {return $msg}
1186    set pnts -1
1187    catch {
1188        set pnts [expr {1+int(($newhist(tmax) - $newhist(tmin))/$newhist(tstep))}]
1189        set qmin [expr {4.*acos(0)/$dmax}]
1190        set qmax [expr {4.*acos(0)/$dmin}]
1191    }
1192    if {$pnts <= 0} {
1193        $np.d1.e3 config -fg red
1194        append msg "Step value of $newhist(tstep) is invalid.\n"
1195    }
1196    if {$pnts >20000} {
1197        $np.d1.e3 config -fg red
1198        append msg "Step value of $newhist(tstep) is too small (>20000 points).\n"
1199    }
1200    if {$msg != ""} {return $msg}
1201    if {$dmin > 0 && $dmax > 0} {
1202        catch {
1203            set msg [format \
1204                    {  %d points.%s  D-space range: %.2f-%.2f A,  Q: %.2f-%.2f/A} \
1205                    $pnts "\n" $dmin $dmax $qmin $qmax]
1206            $np.dl3 config -text $msg
1207        }
1208    }
1209    if {$msg != ""} {return ""}
1210    $np.dl3 config -text [format {  %d points.%s  Range: ?} $pnts "\n"]
1211    return "Invalid data range -- something is wrong!"
1212}
1213
1214proc AddDummyHist {np} {
1215    global newhist expgui expmap
1216    global tcl_platform
1217    set msg [ValidateDummyHist $np]
1218    if {$msg != ""} {
1219        MyMessageBox -parent $np -title  "Add Histogram Error" \
1220                -message "The following error(s) were found in your input:\n$msg" \
1221                -icon error -type ok -default ok \
1222                -helplink "expgui3.html AddHistErr"
1223        return
1224    }
1225
1226    set errmsg [runAddDummyHist $newhist(instfile) $newhist(setnum) \
1227                    $newhist(insttype) \
1228                    $newhist(tmin) $newhist(tmax) $newhist(tstep)]
1229    RecordMacroEntry "runAddDummyHist [list $newhist(instfile)] $newhist(setnum) $newhist(insttype) $newhist(tmin) $newhist(tmax) $newhist(tstep)" 0
1230
1231    if {[regexp {\(P,H,A\)} $expgui(exptoolout)]} {
1232        set msg {You must upgrade the EXPTOOL program.}
1233        append msg { This version cannot add dummy histograms.}
1234        MyMessageBox -icon error -title "Old EXPTOOL program" \
1235                -message $msg -parent $np \
1236                -helplink "expguierr.html OldEXPTOOL"
1237        # update the documentation & link
1238        destroy $np
1239    } elseif {$expgui(showexptool) || $errmsg != ""} {
1240        if {$errmsg != ""} {
1241            set err 1
1242            append errmsg "\n" $expgui(exptoolout) 
1243        } else {
1244            set err 0
1245            set errmsg $expgui(exptoolout) 
1246        }
1247        set msg "Please review the result from adding the dummy histogram" 
1248        if {$err} {append msg "\nIt appears an error occurred!"}
1249        ShowBigMessage $np $msg $errmsg OK "" $err
1250    } else {
1251        destroy $np
1252    }
1253    file delete exptool.in exptool.out
1254    # set the powpref warning (2 = required)
1255    set expgui(needpowpref) 2
1256    set msg "A histogram was added" 
1257    if {[string first $msg $expgui(needpowpref_why)] == -1} {
1258        append expgui(needpowpref_why) "\t$msg\n"
1259    }
1260}
1261proc runAddDummyHist {instfile setnum insttype tmin tmax tstep} {
1262    global expgui expmap tcl_platform
1263    set fp [open exptool.in w]
1264    puts $fp "D"
1265    puts $fp $instfile
1266    puts $fp $setnum
1267    if {$insttype == "TOF"} {
1268        puts $fp "C"
1269    }
1270    puts $fp $tmin
1271    puts $fp $tmax
1272    puts $fp $tstep
1273    puts $fp "X"
1274    puts $fp "0"
1275    close $fp
1276    # Save the current exp file
1277    savearchiveexp
1278    # disable the file changed monitor
1279    set expgui(expModifiedLast) 0
1280    set expnam [file root [file tail $expgui(expfile)]]
1281    set err [catch {
1282        if {$tcl_platform(platform) == "windows"} {
1283            exec [file join $expgui(gsasexe) exptool.exe] $expnam \
1284                    < exptool.in >& exptool.out
1285        } else {
1286            exec [file join $expgui(gsasexe) exptool] $expnam \
1287                    < exptool.in >& exptool.out
1288        }
1289    } errmsg ]
1290    # load the revised exp file
1291    set oldpowderlist $expmap(powderlist)
1292    loadexp $expgui(expfile)
1293    set fp [open exptool.out r]
1294    set expgui(exptoolout) [read $fp]
1295    close $fp
1296    catch {file delete exptool.in exptool.out}
1297    if {[llength $oldpowderlist] == [llength $expmap(powderlist)]} {
1298        set err 1
1299        if {$errmsg == ""} {set errmsg "No histogram added"}
1300    }
1301    if {$err} {
1302        return $errmsg
1303    } else {
1304        return ""
1305    }
1306}
1307
1308#--- multiple histogram stuff
1309proc SetMultipleAdd {np} {
1310    global newhist
1311    $np.f6.b6c configure -state disabled
1312    catch {
1313        if {$newhist(instbanks) == [llength $newhist(banklist)] \
1314                && $newhist(instbanks) > 1} {
1315            $np.f6.b6c configure -state normal
1316        }
1317    }
1318}
1319
1320proc addMultiplehist {np} {
1321    global newhist
1322    # should not happen, but just in case
1323    if {$newhist(instbanks) != [llength $newhist(banklist)]} {
1324        $np.f6.b6c configure -state disable
1325        return
1326    }
1327    catch {destroy [set top $np.addMult]}
1328    toplevel $top
1329    grid [canvas $top.canvas \
1330            -scrollregion {0 0 5000 500} -width 0 -height 250 \
1331            -yscrollcommand "$top.scroll set"] \
1332            -column 0 -columnspan 2 -row 2 -sticky ns
1333    grid columnconfigure $top 0 -weight 1
1334    grid rowconfigure $top 2 -weight 1
1335    scrollbar $top.scroll \
1336            -command "$top.canvas yview"
1337    frame [set cfr $top.canvas.fr]
1338    $top.canvas create window 0 0 -anchor nw -window $cfr
1339    grid [label $top.top \
1340              -text "Select banks to add; set the\nuseful range of data, limiting\nthe # of reflections." -anchor w -justify left \
1341              -bg beige] -column 0 -columnspan 3 -row 0 -sticky ew
1342    grid [frame $top.vartyp -bd 2 -relief groove] \
1343            -column 0 -columnspan 3 -row 1 -sticky ew
1344    grid [label $top.vartyp.top -text "Data limit units:"] -column 0 -row 0 -columnspan 3 -sticky w
1345    grid [radiobutton $top.vartyp.cb3 -text "d-min\n(A)" -variable newhist(LimitMode) \
1346            -value 0] -column 0 -row 1 -sticky w
1347    grid [radiobutton $top.vartyp.cb4 -textvariable newhist(datalimlbl)  \
1348            -variable newhist(LimitMode) -anchor w -justify l \
1349            -value 1] -column 1 -row 1 -sticky w
1350    grid [radiobutton $top.vartyp.cb5 -text "Q-max\n(A-1)" -variable newhist(LimitMode) \
1351            -value 2] -column 2 -row 1 -sticky w
1352   
1353    grid [button $top.add -text Add -command "destroy $np"] -column 0 -row 3
1354    grid [button $top.cancel -text Cancel -command "destroy $top"] \
1355            -column 1 -row 3 -columnspan 2
1356    set row 1
1357    grid [label $cfr.t1 -text "Bank\n#"] -column 0 -row 0
1358    switch $newhist(insttype) {
1359        TOF {set newhist(datalimlbl) "T-min\n(ms)"}
1360        ED  {set newhist(datalimlbl) "E-max\n(KeV)"}
1361        default {set newhist(datalimlbl) "2theta\nmax"}
1362    }
1363    grid [label $cfr.t2 -text "Upper\ndata limit"] -column 1 -row 0
1364    foreach i $newhist(banklist) {
1365        grid [checkbutton $cfr.c$i -text $i \
1366                -variable newhist(usebank$i)] \
1367                -column 0 -row [incr row] -sticky w
1368        set newhist(usebank$i) 1
1369        grid [entry $cfr.e$i -width 8 -textvariable newhist(tlimit$i)] \
1370            -column 1 -row $row -sticky w
1371        lappend newhist(LimitMode_boxes) $cfr.e$i
1372        if {$newhist(insttype) == "TOF"} {
1373            set newhist(tlimit$i) $newhist(tmin$i)
1374            catch {
1375                foreach {x tmin tmax x} $newhist(inst${i}ITYP) {}
1376                if {$tmin > 0} {set newhist(tlimit$i) $tmin}
1377            }
1378        } else {
1379            set newhist(tlimit$i) $newhist(tmax$i)
1380        }
1381    }
1382    # resize the list
1383    update
1384    set sizes [grid bbox $top.canvas.fr]
1385    $top.canvas config -scrollregion $sizes -width [lindex $sizes 2]
1386    # use the scroll for BIG lists
1387    if {[lindex $sizes 3] > [winfo height $top.canvas]} {
1388        grid $top.scroll -sticky ns -column 3 -row 2
1389    } else {
1390        grid forget $top.scroll 
1391    }
1392    update
1393    putontop $top
1394    tkwait window $top
1395    afterputontop
1396
1397    if {[winfo exists $np]} return
1398
1399    # validate the input
1400    set err {}
1401    if {[string trim $newhist(rawfile)] == ""} {
1402        append err "  No data file specified\n"
1403    }
1404    if {[string trim $newhist(instfile)] == ""} {
1405        append err "  No instrument parameter file specified\n"
1406    }
1407    foreach i $newhist(banklist) {
1408        if {$newhist(usebank$i)} {
1409            if {[catch {expr $newhist(tlimit$i)}]} {
1410                append err "  The Max/Min limit is not valid for bank $i\n"
1411            } elseif {$newhist(tlimit$i) <= 0} {
1412                append err "  The Max/Min limit is not valid for bank $i\n"
1413            }
1414        }
1415    }
1416    if {$err != ""} {
1417        MyMessageBox -parent $np -title  "Add Histogram Error" \
1418                -message "The following error(s) were found in your input:\n$err" \
1419                -icon error -type ok -default ok \
1420                -helplink "expgui3.html AddHistErr"
1421        return
1422    }
1423
1424    # ok do it!
1425    global tcl_platform expmap expgui
1426    # Save the current exp file
1427    savearchiveexp
1428    set oldpowderlist $expmap(powderlist)
1429    # disable the file changed monitor
1430    set expgui(expModifiedLast) 0
1431    set k 0
1432    set added 0
1433    set outlog {}
1434    set err 0
1435    pleasewait "adding histograms" expgui(temp)
1436    foreach i $newhist(banklist) {
1437        incr k
1438        if {$newhist(usebank$i)} {
1439            incr added
1440            set expgui(temp) "adding bank $i"
1441            update
1442
1443            if {$newhist(LimitMode) == 1} {
1444                set mode "T"
1445                set value $newhist(tlimit$i)
1446            } elseif {$newhist(LimitMode) == 2} {
1447                set mode "D"
1448                set Q 100
1449                catch {set Q [expr {4*acos(0)/$newhist(tlimit$i)}]}
1450                set value $Q
1451            } else {
1452                set mode "D"
1453                set value $newhist(tlimit$i)
1454            }
1455            set errmsg [runAddHist $newhist(rawfile) $newhist(instfile) $i $k $mode $value]
1456            # save call to Macro file
1457            RecordMacroEntry "runAddHist [list $newhist(rawfile)] [list $newhist(instfile)] $i $k $mode $value" 0
1458            if {$errmsg != ""} {
1459                append outlog "\n\n\nNOTE ERROR:\n" $errmsg $expgui(exptoolout)
1460                set err 1
1461            } else {
1462                append outlog $expgui(exptoolout)
1463            }
1464        }
1465    }
1466    # load the revised exp file
1467    loadexp $expgui(expfile)
1468    if {[llength $oldpowderlist]+$added != [llength $expmap(powderlist)]} {
1469        set err 1
1470    }
1471    # set the powpref warning (2 = required)
1472    set expgui(needpowpref) 2
1473    set msg "A histogram was added" 
1474    if {[string first $msg $expgui(needpowpref_why)] == -1} {
1475        append expgui(needpowpref_why) "\t$msg\n"
1476    }
1477    donewait 
1478    if {$expgui(showexptool) || $err} {
1479        set msg "Please review the result from adding the histogram" 
1480        if {$err} {append msg "\nIt appears an error occurred!"}
1481        ShowBigMessage $np $msg $outlog OK "" $err
1482    }
1483    # select the most recently added histogram
1484    if {!$err} {
1485        set i [llength $expmap(histlistboxcontents)]
1486        if {$i > 0} {
1487            incr i -1
1488            set expgui(curhist) $i
1489            sethistlist
1490        }
1491    }
1492}
1493
1494#----------- Add Atoms routines ----------------------------------------
1495proc MakeAddAtomsBox {phase "atomlist {}"} {
1496    global expmap expgui
1497
1498    # is there room for more atoms? Well, we will check this someday
1499    if {$phase == ""} return
1500    if {[llength $phase] != 1} return
1501
1502    set top .newatoms
1503    catch {destroy $top}
1504    toplevel $top
1505    bind $top <Key-F1> "MakeWWWHelp expgui2.html addatoms"
1506
1507    grid [label $top.l1 -relief groove -bd 4 -anchor center\
1508            -text "Adding atoms to phase #$phase"] \
1509            -column 0 -row 0 \
1510            -sticky we -columnspan 10
1511   
1512    grid [canvas $top.canvas \
1513            -scrollregion {0 0 5000 500} -width 0 -height 250 \
1514            -yscrollcommand "$top.scroll set"] \
1515            -column 0 -row 2 -columnspan 4 -sticky nsew
1516    grid columnconfigure $top 3 -weight 1
1517    grid rowconfigure $top 2 -weight 1
1518    grid rowconfigure $top 1 -pad 5
1519    scrollbar $top.scroll \
1520            -command "$top.canvas yview"
1521    frame $top.canvas.fr
1522    $top.canvas create window 0 0 -anchor nw -window $top.canvas.fr
1523
1524    set np $top.canvas.fr
1525    set row 0
1526    set col 0
1527    grid [label $np.l_${row}0 -text "  #  "] -column $col -row $row
1528    foreach i {Atom\ntype Name x y z Occ Uiso} \
1529            var {type name x y z occ uiso} {
1530        grid [button $np.l_${row}$i -text $i -padx 0 -pady 0 \
1531                -command "sortAddAtoms $phase $top $var"] \
1532                -column [incr col] -row $row -sticky nsew
1533    }
1534    grid [label $np.l_${row}Use -text Use\nFlag] -column [incr col] -row $row
1535
1536    set expgui(SetAddAtomsScroll) 0
1537    set i [llength $atomlist]
1538    if {$i == 0} {incr i}
1539    for {set j 0} {$j < $i} {incr j} {
1540        MakeAddAtomsRow $top
1541    }
1542    set row 0
1543    foreach item $atomlist {
1544        incr row
1545        foreach val $item w {n x y z t o u} {
1546            if {$val != ""} {
1547                $np.e${row}$w delete 0 end
1548                $np.e${row}$w insert end $val
1549            }
1550        }
1551    }
1552    bind $top <Configure> "SetAddAtomsScroll $top"
1553    grid rowconfigure $top 3 -min 10
1554    grid [button $top.b1 -text "Add Atoms"\
1555            -command "addatom $phase $top"] -column 0 -row 5 -sticky w
1556    bind $top <Return> "addatom $phase $top"
1557    grid [button $top.b2 -text Cancel \
1558            -command "destroy $top"] -column 1 -row 5 -sticky w
1559    grid [button $top.help -text Help -bg yellow \
1560            -command "MakeWWWHelp expgui2.html addatoms"] \
1561            -column 0 -columnspan 2 -row 4
1562
1563    # get the input formats if not already defined
1564    GetImportFormats
1565    if {[llength $expgui(importFormatList)] > 0} {
1566        grid [frame $top.fr -bd 4 -relief groove] \
1567                -column 3 -row 5 -columnspan 2 -sticky e
1568        grid [button $top.fr.b3 -text "Import atoms from: " \
1569                -command "ImportAtoms \$expgui(importFormat) $top $phase"] \
1570                -column 0 -row 0 -sticky e
1571        set menu [eval tk_optionMenu $top.fr.b4 expgui(importFormat) \
1572                $expgui(importFormatList)]
1573        for {set i 0} {$i <= [$menu index end]} {incr i} {
1574            $menu entryconfig $i -command "ImportAtoms \$expgui(importFormat) $top $phase"
1575        }
1576        grid $top.fr.b4 -column 1 -row 0 -sticky w
1577        grid rowconfig $top.fr 0 -pad 10
1578        grid columnconfig $top.fr 0 -pad 10
1579        grid columnconfig $top.fr 1 -pad 10
1580    }
1581
1582    grid [button $top.b3 -text  "More atom boxes" \
1583            -command "MakeAddAtomsRow $top"] -column 3 \
1584            -columnspan 2 -row 4 -sticky e
1585   
1586    wm title $top "add new atom"
1587
1588    # set grab, etc.
1589    putontop $top
1590
1591    tkwait window $top
1592
1593    # fix grab...
1594    afterputontop
1595}
1596
1597proc MakeAddAtomsRow {top} {
1598    set np $top.canvas.fr
1599    set col -1
1600    set row 1
1601    # find an empty row
1602    while {![catch {grid info $np.e${row}t}]} {incr row}
1603    grid [label $np.e${row}num -text $row] -column [incr col]  -row $row
1604    grid [entry $np.e${row}t -width 5] -column [incr col]  -row $row
1605    grid [entry $np.e${row}n -width 8] -column [incr col]  -row $row
1606    foreach i {x y z o u} {
1607        grid [entry $np.e${row}$i -width 9] -column [incr col] -row $row
1608    }
1609    grid [checkbutton $np.e${row}use -variable expgui(UseAtom$row)] \
1610            -column [incr col] -row $row
1611    # default occupancy
1612    $np.e${row}o delete 0 end
1613    $np.e${row}o insert end 1.0
1614    # default Uiso
1615    $np.e${row}u delete 0 end
1616    $np.e${row}u insert end 0.025
1617    # default label
1618    $np.e${row}n delete 0 end
1619    $np.e${row}n insert end (default)
1620    # use by default
1621    $np.e${row}use select
1622
1623    SetAddAtomsScroll $top
1624    return $row
1625}
1626
1627proc SetAddAtomsScroll {top} {
1628    global expgui
1629    if $expgui(SetAddAtomsScroll) return
1630    # prevent reentrance
1631    set expgui(SetAddAtomsScroll) 1
1632    update
1633    set sizes [grid bbox $top.canvas.fr]
1634    $top.canvas config -scrollregion $sizes -width [lindex $sizes 2]
1635    # use the scroll for BIG atom lists
1636    if {[lindex $sizes 3] > [winfo height $top.canvas]} {
1637        grid $top.scroll -sticky ns -column 4 -row 2
1638    } else {
1639        grid forget $top.scroll 
1640    }
1641    update
1642    set expgui(SetAddAtomsScroll) 0
1643}
1644
1645set expgui(atmtypelist) {}
1646proc GetAtmTypes {} {
1647    set ::expgui(atmtypelist) {}
1648    set ::expgui(magtypelist) {}
1649    catch {
1650        set fp [open [file join $::expgui(gsasdir) data atmdata.dat] r]
1651        while {[gets $fp line] >= 0} {
1652            set token [string toupper [string trim [string range $line 2 8]]]
1653            if {$token == ""} continue
1654            # nuclear/magnetic
1655            if {[lindex $token 1] == "N" || [lindex $token 1] == "M"} {
1656                set magarr([lindex $token 0]) 1
1657                continue
1658            }
1659            if {[string is integer $token]} continue
1660            if {[string first "_" $token] != -1} {
1661                set sp [split $token "_"]
1662                if {[lindex $sp 1] == ""} continue
1663                if {! [string is integer [lindex $sp 1]]} continue
1664            }
1665            set tmparr([string toupper $token]) 1
1666        }
1667        set ::expgui(atmtypelist) [array names tmparr]
1668        set ::expgui(magtypelist) [array names magarr]
1669        close $fp
1670    } errmsg
1671    if {$::expgui(debug) && $errmsg != ""} {
1672        puts "GetAtmTypes error: $errmsg"
1673    }
1674}
1675
1676# Validate the atoms in the atoms add/phase replace box
1677# returns a null string on error or a list of atoms
1678proc ValidateAtomsBox {top np} {
1679    global expgui
1680    set row 0
1681    # loop over the defined rows
1682    set err {}
1683    set atomlist {}
1684    set validatmtypes {
1685        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
1686        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
1687        NE_20 NE_21 NE_22 NA NA+1 NA_23 MG MG+2 MG_24 MG_25 MG_26 AL AL+3
1688        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
1689        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
1690        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
1691        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
1692        FE+2 FE+3 FE_54 FE_56 FE_57 FE_58 CO CO+2 CO+3 CO_59 NI NI+2 NI+3
1693        NI_58 NI_60 NI_61 NI_62 NI_64 CU CU+1 CU+2 CU_63 CU_65 ZN ZN+2 ZN_64
1694        ZN_66 ZN_67 ZN_68 GA GA+3 GE GE+4 AS AS_75 SE BR BR-1 BR_79 BR_81 KR
1695        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
1696        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
1697        AG+2 CD CD+2 CD_112 CD_113 CD_114 CD_116 IN IN+3 IN_113 IN_115 SN SN+2
1698        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
1699        CE+3 CE+4 PR PR+3 PR+4 PR_141 ND ND+3 PM PM+3 SM SM+3 SM_152
1700        SM_154 EU EU+2 EU+3 EU_153 GD GD+3 GD_160 TB TB+3 TB_159 DY DY+3 HO
1701        HO+3 HO_165 ER ER+3 TM TM+3 TM_169 YB YB+2 YB+3 LU LU+3 HF HF+4 TA
1702        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
1703        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
1704        AT AT_210 RN RN_222 FR FR_223 RA RA+2 RA_226 AC AC+3 AC_227 TH
1705        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
1706        NP_237 PU PU+3 PU+4 PU+6 PU_239 PU_240 PU_242 AM AM_243 CM CM_244 BK
1707        BK_247 CF CF_249
1708    }
1709    # loop over the defined rows
1710    while {![catch {grid info $np.e[incr row]t}]} {
1711        if !{$expgui(UseAtom$row)} continue
1712        # ignore blank entries
1713        set line {}
1714        foreach i {t x y z} {
1715            append line [string trim [$np.e${row}$i get]]
1716        }
1717        if {$line == ""} continue
1718
1719        # validate the input
1720        if {[set type [string trim [$np.e${row}t get]]] == ""} {
1721            append err "  line $row: No atom type specified\n"
1722        }
1723        if {[lsearch $validatmtypes [string toupper $type]] == -1} {
1724            if {[llength $expgui(atmtypelist)] == 0} GetAtmTypes
1725            if {[lsearch $expgui(atmtypelist) [string toupper $type]] == -1} {
1726                if {[lsearch $expgui(magtypelist) [string toupper $type]] == -1} {
1727                    append err "  line $row: Atom type $type is not defined in GSAS.\n\n"
1728                } else {
1729                    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"
1730                }
1731            }
1732        }
1733        set name [string trim [$np.e${row}n get]]
1734        if {$name == "(default)"} {set name "/"}
1735        if {$name == ""} {set name "/"}
1736        foreach i {x y z o u} n {x y z Occ Uiso} {
1737            if {[set $i [string trim [$np.e${row}$i get]]] == ""} {
1738                append err "  line $row: No value specified for $n\n"
1739            } elseif {[catch {expr [set $i]}]} {
1740                append err "  line $row: The value for $n is invalid\n"
1741            }
1742        }
1743        lappend atomlist "$type $x $y $z $o $name I $u"
1744    }
1745    if {$err != ""} {
1746        MyMessageBox -icon warning -message "Note Errors:\n$err" -parent $top
1747        return {}
1748    }
1749    if {[llength $atomlist] == 0} {
1750        MyMessageBox -icon warning -message "No atoms to load!" -parent $top
1751        return {}
1752    }
1753    return $atomlist
1754}
1755
1756proc runAddAtoms {phase atomlist} {
1757    global expgui env expmap tcl_platform
1758    # needed in UNIX
1759    set env(ATOMDATA) [file join $expgui(gsasdir) data atmdata.dat]
1760    set env(gsas) [file nativename $expgui(gsasdir)]
1761    # needed in Windows
1762    set env(GSAS) [file nativename $expgui(gsasdir)]
1763
1764    set fp [open exptool.in w]
1765    puts $fp "A"
1766    puts $fp $phase
1767    # number of atoms
1768    puts $fp [llength $atomlist]
1769    foreach atomline $atomlist {
1770        puts $fp $atomline
1771    }
1772    close $fp
1773 
1774    # Save the current exp file
1775    savearchiveexp
1776    # disable the file changed monitor
1777    set expgui(expModifiedLast) 0
1778    set expnam [file root [file tail $expgui(expfile)]]
1779
1780    set err [catch {
1781        if {$tcl_platform(platform) == "windows"} {
1782            exec [file join $expgui(gsasexe) exptool.exe] $expnam \
1783                    < exptool.in >& exptool.out
1784        } else {
1785            exec [file join $expgui(gsasexe) exptool] $expnam \
1786                    < exptool.in >& exptool.out
1787        }
1788    } errmsg]
1789    # load the revised exp file
1790    set oldatomlist $expmap(atomlist_$phase)
1791    loadexp $expgui(expfile)
1792    set fp [open exptool.out r]
1793    set expgui(exptoolout) [read $fp]
1794    close $fp
1795    catch {file delete exptool.in exptool.out}
1796    if {[llength $oldatomlist] == [llength $expmap(atomlist_$phase))]} {
1797        set err 1
1798        if {$errmsg == ""} {set errmsg "No atom(s) added"}
1799    }
1800}
1801
1802proc addatom {phase top} {
1803    global expgui env expmap
1804    set np $top.canvas.fr
1805    # validate the atoms info
1806    set atomlist [ValidateAtomsBox $top $np]
1807    if {$atomlist == ""} return
1808
1809    # ok add the atoms!
1810    set errmsg [runAddAtoms $phase $atomlist]
1811    RecordMacroEntry "runAddAtoms $phase [list $atomlist]" 0
1812
1813    destroy $top
1814    set err 0
1815    if {$errmsg != ""} {
1816        append errmsg "\n" $expgui(exptoolout)
1817        set err 1
1818    } else {
1819        set errmsg $expgui(exptoolout)
1820    }
1821    if {$expgui(showexptool) || $err} {
1822        set msg "Please review the result from adding the atom(s)" 
1823        if {$err} {append msg "\nIt appears an error occurred!"}
1824        ShowBigMessage $top $msg $errmsg OK "" $err
1825    }
1826}
1827
1828#---------------------------------------------------------------------------
1829# commands to modify a group of selected atoms
1830#---------------------------------------------------------------------------
1831
1832# make the dialog to choose an action
1833proc MakeXformAtomsBox {phase} {
1834    global expgui expmap
1835    set numberList {}
1836    set p $expgui(curPhase)
1837    foreach AtomIndex $expgui(selectedatomlist) {
1838        # get atom number & phase
1839        set tuple [lindex $expmap(atomlistboxcontents) $AtomIndex]
1840        lappend numberList [lindex $tuple 0]
1841    }
1842    if {$numberList == ""} return
1843    if {[llength $numberList] > 1} {
1844        set suffix s
1845        set suffixy "ies"
1846    } else {
1847        set suffix ""
1848        set suffixy "y"
1849    }
1850    set w .global
1851    catch {destroy $w}
1852    toplevel $w
1853    wm title $w "Edit Atomic Parameter -- phase #$phase"
1854    bind $w <Key-F1> "MakeWWWHelp expgui2.html xform"
1855    # this needs to track by phase
1856    grid [label $w.0 \
1857            -text "Modifying atom${suffix} [CompressList $numberList] Phase $phase" \
1858            -bg yellow -anchor center] -row 0 -column 0 -columnspan 10 \
1859            -sticky nsew
1860    grid rowconfigure $w 0 -pad 5
1861    grid rowconfigure $w 1 -minsize 2
1862
1863    grid [TitleFrame $w.1 -bd 6 -relief groove -text "Modify coordinates"] \
1864            -row 2 -column 0 -columnspan 10 -sticky news
1865    set w1 [$w.1 getframe]
1866    set row 0
1867    foreach v {x y z} {
1868        incr row
1869        set col -1
1870        grid [label $w1.l$v -text "new $v   =   "] -column [incr col] -row $row
1871        foreach o {x y z} {
1872            grid [entry $w1.e${v}${o} -width 6] -column [incr col] -row $row
1873            $w1.e${v}${o} delete 0 end
1874            if {$v == $o} {
1875                $w1.e${v}${o} insert end "1.0"
1876            } else {
1877                $w1.e${v}${o} insert end "0."
1878            }
1879            grid [label $w1.p${v}${o} -text " $o  +  "] \
1880                    -column [incr col] -row $row
1881        }
1882        grid [entry $w1.e${v} -width 6] -column [incr col] -row $row
1883        $w1.e${v} delete 0 end
1884        $w1.e${v} insert end "0."
1885    }
1886    grid [button $w1.do -text "Transform Coordinates" \
1887            -command "XformAtomsCoord $phase [list $numberList] $w1" \
1888            ] -row [incr row] -column 0 -columnspan 10
1889
1890    set shift [GetOrigin1Shift $phase]
1891    grid [button $w1.d1 -text "Xform Origin 1 to Origin 2" \
1892              -command "XformAtoms2Origin2 $phase [list $numberList] $w1 [list $shift]" \
1893             ] -row [incr row] -column 3 -columnspan 10 -sticky e
1894    if {$shift == ""} {$w1.d1 config -state disabled}
1895
1896    grid [button $w1.d4 -text "Reset Multiplicities" \
1897                -command "ResetMultiplicities $phase $w" \
1898                ] -row $row -column 0 -columnspan 3 -sticky w
1899
1900
1901    grid rowconfigure $w 3 -minsize 5
1902    grid [TitleFrame $w.4 -bd 6 -relief groove -text "Modify occupanc${suffixy}"] \
1903            -row 4 -column 0 -columnspan 10 -sticky news
1904    set w2 [$w.4 getframe]
1905    grid [label $w2.1 -text "Occupancy: "] -row 1 -column 0
1906    grid [entry $w2.e -width 10] -column 1 -row 1
1907    $w2.e delete 0 end
1908    $w2.e insert end 1.0
1909    grid columnconfigure $w2 2 -weight 1
1910    grid [button $w2.do -text "Set Occupanc${suffixy}" \
1911            -command "XformAtomsOcc $phase [list $numberList] $w2" \
1912            ] -row 2 -column 0 -columnspan 10
1913
1914    grid rowconfigure $w 5 -minsize 5
1915    grid [TitleFrame $w.6 -bd 6 -relief groove \
1916            -text "Modify Displacement Parameter$suffix"] \
1917            -row 6 -column 0 -columnspan 10 -sticky news
1918    set w2 [$w.6 getframe]
1919    grid [entry $w2.e -width 10] -column 1 -row 1
1920    $w2.e delete 0 end
1921    $w2.e insert end 0.025
1922    grid columnconfigure $w2 2 -weight 1
1923    grid [button $w2.do -text "Set U" \
1924            -command "XformAtomsU $phase [list $numberList] $w2" \
1925            ] -row 2 -column 0 -columnspan 10
1926    grid [frame $w2.f] -row 3 -column 0 -columnspan 10
1927
1928    if {[lindex $expmap(phasetype) [expr {$p - 1}]] != 4} {
1929        grid [label $w2.1 -text "Uiso or Uequiv: "] -row 1 -column 0
1930        grid [button $w2.f.iso -text "Set Isotropic" \
1931                -command "XformAtomsU $phase [list $numberList] iso" \
1932                ] -row 0 -column 0
1933        grid [button $w2.f.aniso -text "Set Anisotropic" \
1934                -command "XformAtomsU $phase [list $numberList] aniso" \
1935                ] -row 0 -column 1
1936    } else {
1937        grid [label $w2.1 -text "Uiso: "] -row 1 -column 0
1938    }
1939
1940    grid rowconfigure $w 7 -minsize 5
1941    if {[lindex $expmap(phasetype) [expr {$p - 1}]] != 4} {
1942        grid [TitleFrame $w.8 -bd 6 -relief groove \
1943                -text "Erase Atom$suffix"] \
1944                -row 8 -column 0 -columnspan 10 -sticky news
1945        set w2 [$w.8 getframe]
1946        grid [button $w2.do -text "Erase Atom${suffix}" \
1947                -command "EraseAtoms $phase [list $numberList] $w" \
1948                ] -row 2 -column 0 -columnspan 10
1949    }
1950
1951    grid rowconfigure $w 11 -minsize 5
1952    grid [frame $w.b] -row 12 -column 0 -columnspan 10 -sticky ew
1953    pack [button $w.b.3 -text Close -command "destroy $w"] -side left \
1954            -padx 5 -pady 5
1955    pack [button $w.b.help -text Help -bg yellow \
1956            -command "MakeWWWHelp expgui2.html xform"] -side right \
1957            -padx 5 -pady 5
1958    bind $w <Return> "destroy $w"
1959
1960    # force the window to stay on top
1961    putontop $w
1962    focus $w.b.3
1963    tkwait window $w
1964    afterputontop
1965    # if there are selected atoms, reset their display
1966    if {[llength $expgui(selectedatomlist)] != 0} editRecord
1967}
1968
1969# transform the coordinates
1970proc XformAtomsCoord {phase numberList w1} {
1971    global expgui expmap
1972    if {[lindex $expmap(phasetype) [expr {$phase - 1}]] == 4} {
1973        set cmd mmatominfo
1974    } else {
1975        set cmd atominfo
1976    }
1977    # get the matrix
1978    foreach v {x y z} {
1979        foreach o {x y z} {
1980            set matrix(${v}${o}) [$w1.e${v}${o} get]
1981        }
1982        set matrix(${v}) [$w1.e${v} get]
1983    }
1984    foreach atom $numberList {
1985        foreach v {x y z} {
1986            set $v [$cmd $phase $atom $v]
1987        }
1988        foreach v {x y z} {
1989            set new$v $matrix(${v})
1990            foreach o {x y z} {
1991                set new$v [expr [set new$v] + $matrix(${v}${o})*[set $o]]
1992            }
1993            $cmd $phase $atom $v set [set new$v]
1994            RecordMacroEntry "$cmd $phase $atom $v set [set new$v]" 0
1995        }
1996        incr expgui(changed)
1997    }
1998    RecordMacroEntry "incr expgui(changed)" 0
1999    # update multiplicities for the phase
2000    set parent [winfo toplevel $w1]
2001    ResetMultiplicities $phase $parent
2002    SelectOnePhase $phase
2003    MyMessageBox -parent $parent -type OK -default ok -title "Transform applied" \
2004        -message "The coordinates of atoms [CompressList $numberList] have been transformed"
2005#    UpdateAtomLine $numberList $phase
2006    destroy $parent
2007}
2008
2009# set the occupancies to a single value
2010proc XformAtomsOcc {phase numberList w2} {
2011    global expgui expmap
2012    if {[lindex $expmap(phasetype) [expr {$phase - 1}]] == 4} {
2013        set cmd mmatominfo
2014    } else {
2015        set cmd atominfo
2016    }
2017    # get the value
2018    set val [$w2.e get]
2019    foreach atom $numberList {
2020        $cmd $phase $atom frac set $val
2021        RecordMacroEntry "$cmd $phase $atom frac set $val" 0
2022        incr expgui(changed)
2023    }
2024    RecordMacroEntry "incr expgui(changed)" 0
2025    UpdateAtomLine $numberList $phase
2026}
2027
2028# transform Uiso or Uij; if anisotropic set Uequiv to Uij
2029proc XformAtomsU {phase numberList w2} {
2030    global expgui
2031    set istart $expgui(changed)
2032    if {$w2 == "iso"} {
2033        foreach atom $numberList {
2034            if {[atominfo $phase $atom temptype] != "I"} {
2035                atominfo $phase $atom temptype set I
2036                RecordMacroEntry "atominfo $phase $atom temptype set I" 0
2037                incr expgui(changed)
2038            }
2039        }
2040    } elseif {$w2 == "aniso"} {
2041        foreach atom $numberList {
2042            if {[atominfo $phase $atom temptype] == "I"} {
2043                atominfo $phase $atom temptype set A
2044                RecordMacroEntry "atominfo $phase $atom temptype set A" 0
2045                incr expgui(changed)
2046            }
2047        }
2048    } else {
2049        # get the value
2050        set val [$w2.e get]
2051        foreach atom $numberList {
2052            global expmap
2053            if {[lindex $expmap(phasetype) [expr {$phase - 1}]] == 4} {
2054                mmatominfo $phase $atom Uiso set $val
2055                RecordMacroEntry "mmatominfo $phase $atom Uiso set $val" 0
2056            } elseif {[atominfo $phase $atom temptype] == "I"} {
2057                atominfo $phase $atom Uiso set $val
2058                RecordMacroEntry "atominfo $phase $atom Uiso set $val" 0
2059            } else {
2060                foreach var {U11 U22 U33} {
2061                    atominfo $phase $atom $var set $val
2062                    RecordMacroEntry "atominfo $phase $atom $var set $val" 0
2063                }
2064                foreach var {U12 U13 U23} {
2065                    atominfo $phase $atom $var set 0.0
2066                    RecordMacroEntry "atominfo $phase $atom $var set 0.0" 0
2067                }
2068            }
2069            incr expgui(changed)
2070        }
2071    }
2072    if {$istart != $expgui(changed)} {RecordMacroEntry "incr expgui(changed)" 0}
2073    UpdateAtomLine $numberList $phase
2074}
2075
2076# confirm and erase atoms
2077proc EraseAtoms {phase numberList w2} {
2078    global expgui
2079    if {[llength $numberList] <= 0} return
2080    # make a list of atoms
2081    foreach atom $numberList {
2082        append atomlist "\n\t$atom  [atominfo $phase $atom label]"
2083    }
2084    set msg "OK to remove the following [llength $numberList] atoms from phase $phase:$atomlist"
2085    set val [MyMessageBox -parent $w2 -type okcancel -icon warning \
2086            -default cancel -title "Confirm Erase" -message $msg]
2087    if {$val == "ok"} {
2088        foreach atom $numberList {
2089            EraseAtom $atom $phase
2090            RecordMacroEntry "EraseAtom $atom $phase" 0
2091            incr expgui(changed)
2092        }
2093        RecordMacroEntry "incr expgui(changed)" 0
2094        mapexp
2095        RecordMacroEntry "mapexp" 0
2096        DisplayAllAtoms $phase
2097        destroy $w2
2098    }
2099}
2100
2101#----------- more Add Phase routines (import) -------------------------------
2102proc ImportPhase {format np} {
2103    global expgui
2104    if {[llength $expgui(extensions_$format)] == 1} {
2105        lappend typelist [list $format $expgui(extensions_$format)]
2106    } else {
2107        foreach item $expgui(extensions_$format) {
2108            lappend typelist [list "All $format" $item]
2109            lappend typelist [list "$format $item" $item]
2110        }
2111    }
2112    lappend typelist [list "All files" *]
2113    set file [tk_getOpenFile -parent $np -filetypes $typelist]
2114    if {![file exists $file]} return
2115    # read in the file
2116    set expgui(addPhaseCellType) Any
2117    set input [$expgui(proc_$format) $file]
2118    catch {
2119        $np.bf.b1 config -text "Continue" -command "addphase $np; AddAtomsList"
2120        bind $np <Return> "addphase $np; AddAtomsList"
2121    }
2122    catch {
2123        $np.t1 delete 0 end
2124        $np.t1 insert end "from $file"
2125    }
2126    $np.t2 delete 0 end
2127    $np.t2 insert end [lindex $input 0]
2128    foreach i {.e1a .e1b .e1c .e2a .e2b .e2g} val [lindex $input 1] {
2129        $np.f$i delete 0 end
2130        $np.f$i insert end $val
2131    }
2132    set expgui(coordList) [lindex $input 2]
2133    set msg [lindex $input 3]
2134    if {$msg != ""} {
2135        catch {destroy $np.msg}
2136        grid [label $np.msg -text $msg -fg red -anchor center -bd 4 -relief raised] \
2137                -column 0 -columnspan 99 -row 20 -sticky ew
2138    }
2139}
2140
2141proc ImportAtoms {format top phase} {
2142    global expgui
2143    if {[llength $expgui(extensions_$format)] == 1} {
2144        lappend typelist [list $format $expgui(extensions_$format)]
2145    } else {
2146        foreach item $expgui(extensions_$format) {
2147            lappend typelist [list "All $format" $item]
2148            lappend typelist [list "$format $item" $item]
2149        }
2150    }
2151    lappend typelist [list "All files" *]
2152    set file [tk_getOpenFile -parent $top -filetypes $typelist]
2153    if {![file exists $file]} return
2154    # disable during read
2155    catch {
2156        foreach b "$top.b1 $top.b2 $top.fr.b3" {
2157            $b config -state disabled
2158        }
2159    }
2160    # read in the file
2161    set input [$expgui(proc_$format) $file]
2162    # add atoms to table
2163    foreach item [lindex $input 2] {
2164        set row [MakeAddAtomsRow $top]
2165        set np $top.canvas.fr
2166        foreach val $item w {n x y z t o u} {
2167            if {$val != ""} {
2168                $np.e${row}$w delete 0 end
2169                $np.e${row}$w insert end $val
2170            }
2171        }
2172    }
2173    # sort the atoms by number, so that empty entries are at the bottom
2174    sortAddAtoms $phase $top number
2175    # reenable
2176    catch {
2177        foreach b "$top.b1 $top.b2 $top.fr.b3" {
2178            $b config -state normal
2179        }
2180    }
2181}
2182
2183proc AddAtomsList {} {
2184    global expgui expmap
2185    # skip if we aborted out of addphase
2186    if {$expgui(oldphaselist) == -1} return
2187    # find the new phase
2188    set phase {}
2189    foreach p $expmap(phaselist) {
2190        if {[lsearch $expgui(oldphaselist) $p] == -1} {
2191            set phase $p
2192            break
2193        }
2194    }
2195    if {$phase == ""} return
2196    MakeAddAtomsBox $phase $expgui(coordList)
2197}
2198
2199# get the input formats by sourcing files named import_*.tcl
2200proc GetImportFormats {} {
2201    global expgui tcl_platform
2202    # only needs to be done once
2203    if [catch {set expgui(importFormatList)}] {
2204        set filelist [glob -nocomplain [file join $expgui(scriptdir) import_*.tcl]]
2205        foreach file $filelist {
2206            set description ""
2207            source $file
2208            if {$description != ""} {
2209                lappend expgui(importFormatList) $description
2210                if {$tcl_platform(platform) == "unix"} {
2211                    set extensions "[string tolower $extensions] [string toupper $extensions]"
2212                }
2213                set expgui(extensions_$description) $extensions
2214                set expgui(proc_$description) $procname
2215            }
2216        }
2217    }
2218}
2219
2220proc MakeReplacePhaseBox {} {
2221    global expmap expgui tcl_platform
2222
2223    set expgui(coordList) {}
2224    # ignore the command if no phase is selected
2225    foreach p {1 2 3 4 5 6 7 8 9} {
2226        if {[lsearch $expmap(phaselist) $expgui(curPhase)] == -1} {
2227            return
2228        }
2229    }
2230
2231    set top .newphase
2232    catch {destroy $top}
2233    toplevel $top
2234    bind $top <Key-F1> "MakeWWWHelp expgui2.html replacephase"
2235
2236    grid [label $top.l1 -text "Replacing phase #$expgui(curPhase)" \
2237            -bg yellow -anchor center] -column 0 -columnspan 8 -row 0 -sticky ew
2238    grid [label $top.l3a -text "Current Space Group: "] \
2239            -column 0 -row 2 -columnspan 2 -sticky e
2240    grid [label $top.l3b -text [phaseinfo $expgui(curPhase) spacegroup]\
2241            -bd 4 -relief groove] \
2242            -column 2 -row 2  -sticky ew
2243    grid [label $top.l4 -text "New Space Group: "] \
2244            -column 0 -row 3 -columnspan 2 -sticky e
2245    grid [entry $top.t2 -width 12] -column 2 -row 3 -sticky w
2246    grid [radiobutton $top.r1 -text "Keep atoms in phase"\
2247            -variable expgui(DeleteAllAtoms) -value 0] \
2248            -column 1 -row 4 -columnspan 8 -sticky w
2249    grid [radiobutton $top.r2 -text "Delete current atoms" \
2250            -variable expgui(DeleteAllAtoms) -value 1] \
2251            -column 1 -row 5 -columnspan 8 -sticky w
2252   
2253    grid [frame $top.f -bd 4 -relief groove] \
2254            -column 3 -row 2 -columnspan 3 -rowspan 4
2255    set col -1
2256    foreach i {a b c} {
2257        grid [label $top.f.l1$i -text " $i "] -column [incr col] -row 1
2258        grid [entry $top.f.e1$i -width 12] -column [incr col]  -row 1
2259        $top.f.e1$i delete 0 end
2260        $top.f.e1$i insert 0 [phaseinfo $expgui(curPhase) $i]
2261    }
2262    set col -1
2263    foreach i {a b g} var {alpha beta gamma} {
2264        grid [label $top.f.l2$i -text $i] -column [incr col] -row 2
2265        set font [$top.f.l2$i cget -font]
2266        $top.f.l2$i config -font "Symbol [lrange $font 1 end]"
2267        grid [entry $top.f.e2$i -width 12] -column [incr col]  -row 2
2268        $top.f.e2$i delete 0 end
2269        $top.f.e2$i insert 0 [phaseinfo $expgui(curPhase) $var]
2270    } 
2271
2272    grid [button $top.b1 -text Continue \
2273            -command "replacephase1 $top $expgui(curPhase)"] \
2274            -column 0 -row 6 -sticky w
2275    bind $top <Return> "replacephase1 $top $expgui(curPhase)"
2276    grid [button $top.b2 -text Cancel \
2277            -command "destroy $top"] -column 1 -row 6 -sticky w
2278    grid [button $top.help -text Help -bg yellow \
2279            -command "MakeWWWHelp expgui2.html replacephase"] \
2280            -column 2 -row 6
2281
2282    # get the input formats if not already defined
2283    GetImportFormats
2284    if {[llength $expgui(importFormatList)] > 0} {
2285        grid [frame $top.fr -bd 4 -relief groove] \
2286                -column 2 -row 6 -columnspan 8 -sticky e
2287        grid [button $top.fr.b3 -text "Import phase from: " \
2288                -command "ImportPhase \$expgui(importFormat) $top"] \
2289                -column 0 -row 0 -sticky e
2290        set menu [eval tk_optionMenu $top.fr.b4 expgui(importFormat) \
2291                $expgui(importFormatList)]
2292        for {set i 0} {$i <= [$menu index end]} {incr i} {
2293            $menu entryconfig $i -command "ImportPhase \$expgui(importFormat) $top"
2294        }
2295        grid $top.fr.b4 -column 1 -row 0 -sticky w
2296        grid rowconfig $top.fr 0 -pad 10
2297        grid columnconfig $top.fr 0 -pad 10
2298        grid columnconfig $top.fr 1 -pad 10
2299#       grid columnconfig $top 4 -weight 1
2300        grid columnconfig $top 2 -weight 1
2301    }
2302   
2303    wm title $top "Replace phase $expgui(curPhase)"
2304
2305    # set grab, etc.
2306    putontop $top
2307
2308    tkwait window $top
2309
2310    # fix grab...
2311    afterputontop
2312}
2313
2314proc replacephase1 {top phase} {
2315    # validate cell & space group & save to pass
2316    global expgui expmap
2317    set expgui(SetAddAtomsScroll) 0
2318    # validate the input
2319    set err {}
2320    set spg [$top.t2 get]
2321    if {[string trim $spg] == ""} {
2322        append err "  Space group cannot be blank\n"
2323    }
2324    set cell {}
2325    foreach i {a b c a b g} lbl {a b c alpha beta gamma} n {1 1 1 2 2 2} {
2326        set $lbl [$top.f.e${n}$i get]
2327        if {[string trim [set $lbl]] == ""} {
2328            append err "  $lbl cannot be blank\n"
2329        } elseif {[catch {expr [set $lbl]}]} {
2330            append err "  [set $lbl] is not valid for $lbl\n"
2331        }
2332        lappend cell [set $lbl]
2333    }
2334
2335    if {$err != ""} {
2336        MyMessageBox -parent $top -title "Replace Phase Error" -icon warning \
2337                -message "The following error(s) were found in your input:\n$err" 
2338        return
2339    }
2340
2341    # check the space group
2342    set fp [open spg.in w]
2343    puts $fp "N"
2344    puts $fp "N"
2345    puts $fp $spg
2346    puts $fp "Q"
2347    close $fp
2348    global tcl_platform
2349    catch {
2350        if {$tcl_platform(platform) == "windows"} {
2351            exec [file join $expgui(gsasexe) spcgroup.exe] < spg.in >& spg.out
2352        } else {
2353            exec [file join $expgui(gsasexe) spcgroup] < spg.in >& spg.out
2354        }
2355    }
2356    set fp [open spg.out r]
2357    set out [read $fp]
2358    close $fp
2359    # attempt to parse out the output (fix up if parse did not work)
2360    if {[regexp "space group symbol.*>(.*)Enter a new space group symbol" \
2361            $out a b ] != 1} {set b $out}
2362    if {[string first Error $b] != -1} {
2363        # got an error, show it
2364        ShowBigMessage \
2365                 $top.error \
2366                 "Error processing space group\nReview error message below" \
2367                 $b OK "" 1
2368        return
2369    } else {
2370        # show the result and confirm
2371        set opt [ShowBigMessage \
2372                $top.check \
2373                "Check the symmetry operators in the output below" \
2374                $b \
2375                {Continue Redo} ]
2376        if {$opt > 1} return
2377    }
2378    file delete spg.in spg.out
2379    # draw coordinates box
2380    eval destroy [winfo children $top]
2381    grid [label $top.l1 -relief groove -bd 4 -anchor center\
2382            -text "Atom list for phase #$phase"] \
2383            -column 0 -row 0 \
2384            -sticky we -columnspan 10
2385    grid [canvas $top.canvas \
2386            -scrollregion {0 0 5000 500} -width 0 -height 250 \
2387            -yscrollcommand "$top.scroll set"] \
2388            -column 0 -row 2 -columnspan 4 -sticky nsew
2389    grid columnconfigure $top 3 -weight 1
2390    grid rowconfigure $top 2 -weight 1
2391    grid rowconfigure $top 1 -pad 5
2392    scrollbar $top.scroll \
2393            -command "$top.canvas yview"
2394    frame $top.canvas.fr
2395    $top.canvas create window 0 0 -anchor nw -window $top.canvas.fr
2396
2397    set np $top.canvas.fr
2398    set row 0
2399    set col 0
2400    grid [label $np.l_${row}0 -text "  #  "] -column $col -row $row
2401    foreach i {Atom\ntype Name x y z Occ Uiso} \
2402            var {type name x y z occ uiso} {
2403        grid [button $np.l_${row}$i -text $i -padx 0 -pady 0 \
2404                -command "sortAddAtoms $phase $top $var"] \
2405                -column [incr col] -row $row -sticky nsew
2406    }
2407    grid [label $np.l_${row}Use -text Use\nFlag] -column [incr col] -row $row
2408
2409    # add the old atoms, if appropriate
2410    if {!$expgui(DeleteAllAtoms)} {
2411        # loop over all atoms
2412        foreach atom $expmap(atomlist_$phase) {
2413            set row [MakeAddAtomsRow $top]
2414            # add all atoms in the current phase to the list
2415            foreach w {n x y z t o} var {label x y z type frac} {
2416                $np.e${row}$w delete 0 end
2417                $np.e${row}$w insert end [atominfo $phase $atom $var]
2418            }
2419            $np.e${row}u delete 0 end
2420            if {[atominfo $phase $atom temptype] == "I"} {
2421                $np.e${row}u insert end [atominfo $phase $atom Uiso]
2422            } else {
2423                $np.e${row}u insert end [expr ( \
2424                        [atominfo $phase $atom U11] + \
2425                        [atominfo $phase $atom U22] + \
2426                        [atominfo $phase $atom U33]) / 3.]
2427            }
2428        }
2429    }
2430
2431    # add coordinates that have been read in, if any
2432    foreach item $expgui(coordList) {
2433        set row [MakeAddAtomsRow $top]
2434        foreach val $item w {n x y z t o u} {
2435            if {$val != ""} {
2436                $np.e${row}$w delete 0 end
2437                $np.e${row}$w insert end $val
2438            }
2439        }
2440    }
2441    # a blank spot in the table
2442    MakeAddAtomsRow $top
2443
2444    bind $top <Configure> "SetAddAtomsScroll $top"
2445    grid rowconfigure $top 3 -min 10
2446    grid [button $top.b1 -text "Continue"\
2447            -command "replacephase2 $phase $top [list $spg] [list $cell]"] \
2448            -column 0 -row 5 -sticky w
2449    bind $top <Return> "replacephase2 $phase $top [list $spg] [list $cell]"
2450    grid [button $top.b2 -text Cancel \
2451            -command "destroy $top"] -column 1 -row 5 -sticky w
2452    if {[llength $expgui(importFormatList)] > 0} {
2453        grid [frame $top.fr -bd 4 -relief groove] \
2454                -column 3 -row 5 -columnspan 2 -sticky e
2455        grid [button $top.fr.b3 -text "Import atoms from: " \
2456                -command "ImportAtoms \$expgui(importFormat) $top $phase"] \
2457                -column 0 -row 0 -sticky e
2458        set menu [eval tk_optionMenu $top.fr.b4 expgui(importFormat) \
2459                $expgui(importFormatList)]
2460        for {set i 0} {$i <= [$menu index end]} {incr i} {
2461            $menu entryconfig $i -command "ImportAtoms \$expgui(importFormat) $top $phase"
2462        }
2463        grid $top.fr.b4 -column 1 -row 0 -sticky w
2464        grid rowconfig $top.fr 0 -pad 10
2465        grid columnconfig $top.fr 0 -pad 10
2466        grid columnconfig $top.fr 1 -pad 10
2467    }
2468
2469    grid [button $top.b3 -text  "More atom boxes" \
2470            -command "MakeAddAtomsRow $top"] -column 3 \
2471            -columnspan 2 -row 4 -sticky e
2472   
2473    wm title $top "Replacing phase: Enter atoms"
2474    SetAddAtomsScroll $top
2475
2476    # fix grab for old window
2477    afterputontop
2478    # set grab, etc.
2479    putontop $top
2480}
2481
2482proc replacephase2 {phase top spg cell} {
2483    global expgui expmap
2484    # validate coordinates
2485    set np $top.canvas.fr
2486    # validate the atoms info
2487    set atomlist [ValidateAtomsBox $top $np]
2488    if {$atomlist == ""} return
2489
2490    pleasewait "updating phase"
2491    set errmsg [replacephase3 $phase $spg $cell $atomlist]
2492
2493    set err 0
2494    if {[llength $atomlist] != [llength $expmap(atomlist_$phase))]} {
2495        set err 1
2496    }
2497    if {$errmsg != ""} {
2498        set err 1
2499    }
2500    donewait 
2501    if {$expgui(showexptool) || $err} {
2502        set msg "Please review the result from adding the atom(s)" 
2503        if {$err} {append msg "\nIt appears an error occurred!"}
2504        ShowBigMessage $top $msg $errmsg OK "" $err
2505    }
2506    # set the powpref warning (2 = required)
2507    set expgui(needpowpref) 2
2508    set msg "A phase was replaced"
2509    if {[string first $msg $expgui(needpowpref_why)] == -1} {
2510        append expgui(needpowpref_why) "\t$msg\n"
2511    }
2512    destroy $top
2513}
2514
2515
2516proc replacephase3 {phase spg cell atomlist} {
2517    global expgui expmap
2518    # replace spacegroup and cell
2519    if $::expgui(debug) {puts "phaseinfo $phase spacegroup set $spg"}
2520    phaseinfo $phase spacegroup set $spg
2521    RecordMacroEntry "phaseinfo $phase spacegroup set [list $spg]" 0
2522    foreach val $cell var {a b c alpha beta gamma} {
2523        phaseinfo $phase $var set $val
2524        RecordMacroEntry "phaseinfo $phase $var set $val" 0
2525    }
2526    incr expgui(changed) 
2527    # delete all atoms
2528    foreach i $expmap(atomlist_$phase) {
2529        EraseAtom $i $phase
2530        RecordMacroEntry "EraseAtom $i $phase" 0
2531        incr expgui(changed)
2532    }
2533    set expmap(atomlist_$phase) {}
2534    RecordMacroEntry "incr expgui(changed)" 0
2535    # write new atoms from table as input to exptool
2536    set errmsg [runAddAtoms $phase $atomlist]
2537    RecordMacroEntry "runAddAtoms $phase [list $atomlist]" 0
2538    SpaceGroupWarnings "" $phase $spg
2539    return $errmsg
2540}
2541
2542proc SpaceGroupWarnings {warn phase spg} {
2543    # warning on possible origin 1 setting
2544    set shift [GetOrigin1Shift $phase]
2545    if {$shift != ""} {
2546        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"
2547    }
2548    if {$warn != ""} {
2549        MyMessageBox -parent . -title "Space Group Note" \
2550            -message $warn -icon warning
2551    }
2552}
2553
2554proc sortAddAtoms {phase top sortvar} {
2555    global expgui
2556    set np $top.canvas.fr
2557    set validlist {}
2558    set invalidlist {}
2559    set row 0
2560    while {![catch {grid info $np.e[incr row]t}]} {
2561        set valid 1
2562        set line $row
2563        if !{$expgui(UseAtom$row)} {set valid 0}
2564        lappend line $expgui(UseAtom$row)
2565        if {[set type [string trim [$np.e${row}t get]]] == ""} {set valid 0}
2566        lappend line [string trim [$np.e${row}t get]]
2567        lappend line [string trim [$np.e${row}n get]]
2568        foreach i {x y z o u} {
2569            set tmp [string trim [$np.e${row}$i get]]
2570            lappend line $tmp
2571            if {$tmp == "" || [catch {expr $tmp}]} {set valid 0}
2572        }
2573        if {$valid} {
2574            lappend validlist $line
2575        } else {
2576            lappend invalidlist $line
2577        }
2578    }
2579    switch $sortvar {
2580        type {set sortlist [lsort -index 2 -dictionary $validlist]}
2581        name {set sortlist [lsort -index 3 -dictionary $validlist]}
2582        x {set sortlist [lsort -index 4 -real $validlist]}
2583        y {set sortlist [lsort -index 5 -real $validlist]}
2584        z {set sortlist [lsort -index 6 -real $validlist]}
2585        occ {set sortlist [lsort -index 7 -real $validlist]}
2586        uiso  {set sortlist [lsort -index 8 -real $validlist]}
2587        default {set sortlist $validlist}
2588    }
2589
2590    if {[llength $invalidlist] > 0} {append sortlist " $invalidlist"}
2591    set row 0
2592    foreach line $sortlist {
2593        incr row
2594        set expgui(UseAtom$row) [lindex $line 1]
2595        foreach item [lrange $line 2 end] \
2596                var {t n x y z o u} {
2597            $np.e${row}$var delete 0 end
2598            $np.e${row}$var insert end $item
2599        }
2600    }
2601}
2602
2603proc EditInstFile {"filename {}"} {
2604    global expgui
2605    # on the first call, load the commands
2606    if {[catch {
2607        if {[info procs instMakeWindow] == ""} {
2608            source [file join $expgui(scriptdir) instedit.tcl]
2609        }
2610    } errmsg]} {
2611        MyMessageBox -parent . -title "Load error" \
2612                -message "Unexpected error while sourcing file instedit.tcl: $errmsg" \
2613                -icon error
2614    }
2615    instMakeWindow $filename
2616}
2617
2618# load a list of Origin 1/2 space groups
2619proc GetOrigin12List {} {
2620    # don't need to read the file twice
2621    if {[array names ::Origin1list] != ""} return
2622    set line {}
2623    set fp1 [open [file join $::expgui(scriptdir) spacegrp.ref] r]
2624    while {[lindex $line 1] != 230} {
2625        if {[gets $fp1 line] < 0} break
2626    }
2627    while {[gets $fp1 line] >= 0} {
2628        set key [string tolower [lindex $line 8]]
2629        regsub -all " " $key "" key
2630        regsub -- "-3" $key "3" key
2631        if {$key != ""} {
2632#       puts "$key -- [lindex $line 1] [lindex $line 8] [lindex $line 9]"
2633            set ::Origin1list($key) [lindex $line 9]
2634        }
2635    }
2636    close $fp1
2637}
2638
2639# get the shift to be added to origin 1 coordinates to obtain origin 2 settings
2640proc GetOrigin1Shift {phase} {
2641    GetOrigin12List
2642    set spg [string tolower [phaseinfo $phase spacegroup]]
2643    regsub -all " " $spg "" spg
2644    regsub -- "-3" $spg "3" spg
2645    if {[catch {set shift $::Origin1list($spg)}]} {
2646        return ""
2647    } else {
2648        return $shift
2649    }
2650}
2651
2652proc XformAtoms2Origin2 {phase numberList w1 shift} {
2653    global expgui expmap
2654    set parent [winfo toplevel $w1]
2655    if {[llength $numberList] != [llength $expmap(atomlist_$phase)]} {
2656        # not all atoms were selected in phase -- do a sanity check
2657        set msg {You have selected only some atoms to be shifted. Do you want to shift all atoms or only the selected atoms?}
2658        set val [MyMessageBox -parent $parent -icon warning \
2659                     -type "{Use all} {Use Selection}" -default "use all" \
2660                     -title "Shift all" -message $msg]
2661#       puts "$phase $numberList $w1 $shift"
2662        if {$val == "use all"} {set numberList $expmap(atomlist_$phase)}
2663    }
2664    if {[lindex $expmap(phasetype) [expr {$phase - 1}]] == 4} {
2665        set cmd mmatominfo
2666    } else {
2667        set cmd atominfo
2668    }
2669    foreach atom $numberList {
2670        foreach v {x y z} vs $shift {
2671            set c [$cmd $phase $atom $v]
2672            $cmd $phase $atom $v set [expr {$c + $vs}]
2673            RecordMacroEntry "$cmd $phase $atom $v set [expr {$c + $vs}]" 0
2674        }
2675        incr expgui(changed)
2676    }
2677
2678    RecordMacroEntry "incr expgui(changed)" 0
2679    ResetMultiplicities $phase $parent
2680    SelectOnePhase $phase
2681    MyMessageBox -parent $parent -type OK -default ok -title "Shift applied" \
2682        -message "A shift of \"$shift\" has been added to coordinates of atoms [CompressList $numberList]"
2683#    UpdateAtomLine $numberList $phase
2684    destroy $parent
2685}
2686
2687# reset the site multiplicities using the EXPEDT program
2688proc ResetMultiplicities {phase parent} {
2689    global expgui
2690    set errmsg [RunResetMultiplicities $phase]
2691    RecordMacroEntry "RunResetMultiplicities $phase" 0
2692
2693    if {$expgui(showexptool) || $errmsg != ""} {
2694        if {$errmsg != ""} {
2695            set err 1
2696            append errmsg "\n" $expgui(exptoolout) 
2697        } else {
2698            set err 0
2699            set errmsg $expgui(exptoolout) 
2700        }
2701        set msg "Please review the result from listing the phase." 
2702        if {$errmsg != ""} {append msg "\nIt appears an error occurred!"}
2703        ShowBigMessage $parent.msg $msg $errmsg OK "" $err
2704    }
2705}
2706proc RunResetMultiplicities {phase} {
2707    global expgui tcl_platform
2708    set input [open resetmult.inp w]
2709    puts $input "Y"
2710    puts $input "l a p $phase"
2711    puts $input "l"
2712    puts $input "x x x"
2713    puts $input "x"
2714    close $input
2715    # Save the current exp file
2716    savearchiveexp
2717    # disable the file changed monitor
2718    set expgui(expModifiedLast) 0
2719    set expnam [file root [file tail $expgui(expfile)]]
2720    set err [catch {
2721        if {$tcl_platform(platform) == "windows"} {
2722            exec [file join $expgui(gsasexe) expedt.exe] $expnam < resetmult.inp >& resetmult.out
2723        } else {
2724            exec [file join $expgui(gsasexe) expedt] $expnam < resetmult.inp >& resetmult.out
2725        }
2726    } errmsg]
2727    loadexp $expgui(expfile)
2728    set fp [open resetmult.out r]
2729    set out [read $fp]
2730    close $fp
2731    set expgui(exptoolout) $out
2732    catch {file delete resetmult.inp resetmult.out}
2733    if {$err} {
2734        return $errmsg
2735    } else {
2736        return ""
2737    }
2738}
2739
2740# default values
2741set newhist(insttype) {}
2742set newhist(dummy) 0
2743set newhist(instfiletext) {}
2744set newhist(instbanks) {}
Note: See TracBrowser for help on using the repository browser.