source: trunk/addcmds.tcl @ 1025

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

see https://subversion.xor.aps.anl.gov/trac/EXPGUI/wiki/News20101013

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