source: trunk/addcmds.tcl

Last change on this file was 1251, checked in by toby, 7 years ago

use svn ps svn:eol-style "native" * to change line ends

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