source: trunk/addcmds.tcl @ 1188

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

update to match bug fixs in sandbox

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