source: trunk/addcmds.tcl @ 992

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

changes for POWGEN: profile #<0; use data limits from prm file for TOF

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