source: branches/sandbox/addcmds.tcl @ 1115

Last change on this file since 1115 was 1109, checked in by toby, 11 years ago

recent changes: fix coordinates, rb start

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