source: trunk/addcmds.tcl @ 694

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

# on 2003/05/22 21:39:30, toby did:
Add instrument parameter file editor

  • Property rcs:author set to toby
  • Property rcs:date set to 2003/05/22 21:39:30
  • Property rcs:lines set to +20 -1
  • Property rcs:rev set to 1.31
  • Property rcs:state set to Exp
  • Property svn:keywords set to Author Date Revision Id
File size: 64.7 KB
RevLine 
[92]1# $Id: addcmds.tcl 694 2009-12-04 23:10:27Z toby $
2
[447]3#----------- Add Phase routines ----------------------------------------
4
[92]5proc MakeAddPhaseBox {} {
[383]6    global expmap expgui
[92]7
[268]8    set expgui(coordList) {}
[92]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 == ""} {
[383]19        MyMessageBox -parent . -title "Add Phase Error" \
20                -message "There are already 9 phases. You cannot add more." \
21                -icon error
[92]22        return
23    }
24
25    set np .newphase
26    catch {destroy $np}
27    toplevel $np
[321]28    bind $np <Key-F1> "MakeWWWHelp expgui2.html addphase"
[92]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.f -bd 4 -relief groove] -column 3 -row 2 -columnspan 8
37    set col -1
38    foreach i {a b c} {
[268]39        grid [label $np.f.l1$i -text " $i "] -column [incr col] -row 1
[92]40        grid [entry $np.f.e1$i -width 12] -column [incr col]  -row 1
41    }
42    set col -1
43    foreach i {a b g} {
[413]44        grid [label $np.f.l2$i -text $i] -column [incr col] -row 2
45        set font [$np.f.l2$i cget -font]
46        $np.f.l2$i config -font "Symbol [lrange $font 1 end]"
[92]47        grid [entry $np.f.e2$i -width 12] -column [incr col]  -row 2
48        $np.f.e2$i insert 0 90.
49    }   
50   
[268]51    grid [frame $np.bf] -row 3 -column 0 -columnspan 10 -sticky ew
52    grid [button $np.bf.b1 -text Add \
[92]53            -command "addphase $np"] -column 2 -row 3
54    bind $np <Return> "addphase $np"
[268]55    grid [button $np.bf.b2 -text Cancel \
[92]56            -command "destroy $np"] -column 3 -row 3
[268]57    grid columnconfig $np.bf 4 -weight 1
[321]58    grid [button $np.bf.help -text Help -bg yellow \
59            -command "MakeWWWHelp expgui2.html addphase"] \
60            -column 4 -row 3
[268]61
62    # get the input formats if not already defined
63    GetImportFormats
64    if {[llength $expgui(importFormatList)] > 0} {
65        grid [frame $np.bf.fr -bd 4 -relief groove] -column 5 -row 3
66        grid [button $np.bf.fr.b3 -text "Import phase from: " \
67                -command "ImportPhase \$expgui(importFormat) $np"] \
68                -column 0 -row 0 -sticky e
[553]69        set menu [eval tk_optionMenu $np.bf.fr.b4 expgui(importFormat) \
70                $expgui(importFormatList)]
71        for {set i 0} {$i <= [$menu index end]} {incr i} {
72            $menu entryconfig $i -command "ImportPhase \$expgui(importFormat) $np"
73        }
[268]74        grid $np.bf.fr.b4 -column 1 -row 0 -sticky w
75        grid rowconfig $np.bf.fr 0 -pad 10
76        grid columnconfig $np.bf.fr 0 -pad 10
77        grid columnconfig $np.bf.fr 1 -pad 10
78    }
[92]79    wm title $np "add new phase"
80
[326]81    # set grab, etc.
[92]82    putontop $np
[268]83   
[92]84    tkwait window $np
[268]85   
[326]86    # fix grab...
[92]87    afterputontop
88}
89
90proc addphase {np} {
[237]91    global expgui expmap
[92]92    # validate the input
93    set err {}
94    set title [$np.t1 get]
95    if {[string trim $title] == ""} {
96        append err "  Title cannot be blank\n"
97    }
98    set spg [$np.t2 get]
99    if {[string trim $spg] == ""} {
100        append err "  Space group cannot be blank\n"
101    }
102    foreach i {a b c} {
103        set cell($i) [$np.f.e1$i get]
104        if {[string trim $cell($i)] == ""} {
105            append err "  $i cannot be blank\n"
106        } elseif {[catch {expr $cell($i)}]} {
107            append err "  $i is not valid\n"
108        }
109    }
110
111    foreach i {a b g} lbl {alpha beta gamma} {
112        set cell($lbl) [$np.f.e2$i get]
113        if {[string trim $cell($lbl)] == ""} {
114            append err "  $lbl cannot be blank\n"
115        } elseif {[catch {expr $cell($lbl)}]} {
116            append err "  $lbl is not valid\n"
117        }
118    }
119
120    if {$err != ""} {
[383]121        MyMessageBox -parent . -title "Add Phase Error" \
122                -message "The following error(s) were found in your input:\n$err" \
123                -icon error
[378]124        set expgui(oldphaselist) -1
[92]125        return
126    }
127
128    # check the space group
129    set fp [open spg.in w]
130    puts $fp "N"
131    puts $fp "N"
132    puts $fp $spg
133    puts $fp "Q"
134    close $fp
135    global tcl_platform
136    catch {
137        if {$tcl_platform(platform) == "windows"} {
138            exec [file join $expgui(gsasexe) spcgroup.exe] < spg.in >& spg.out
139        } else {
140            exec [file join $expgui(gsasexe) spcgroup] < spg.in >& spg.out
141        }
142    }
143    set fp [open spg.out r]
144    set out [read $fp]
145    close $fp
146    # attempt to parse out the output (fix up if parse did not work)
147    if {[regexp "space group symbol.*>(.*)Enter a new space group symbol" \
148            $out a b ] != 1} {set b $out}
149    if {[string first Error $b] != -1} {
150        # got an error, show it
151        ShowBigMessage \
152                 $np.error \
153                 "Error processing space group\nReview error message below" \
[447]154                 $b OK "" 1
[378]155        set expgui(oldphaselist) -1
[92]156        return
157    } else {
158        # show the result and confirm
159        set opt [ShowBigMessage \
160                $np.check \
161                "Check the symmetry operators in the output below" \
162                $b \
163                {Continue Redo} ]
[378]164        if {$opt > 1} {
165            set expgui(oldphaselist) -1
166            return
167        }
[92]168    }
169    file delete spg.in spg.out
170   
171    # ok do it!
172    set fp [open exptool.in w]
173    puts $fp "P"
174    puts $fp $title
175    puts $fp $spg
176    puts $fp "$cell(a) $cell(b) $cell(c) $cell(alpha) $cell(beta) $cell(gamma)"
177    puts $fp "/"
178    close $fp
179    global tcl_platform
180    # Save the current exp file
181    savearchiveexp
182    # disable the file changed monitor
183    set expgui(expModifiedLast) 0
184    set expnam [file root [file tail $expgui(expfile)]]
[268]185    # save the previous phase list
186    set expgui(oldphaselist) $expmap(phaselist)
[92]187    catch {
188        if {$tcl_platform(platform) == "windows"} {
189            exec [file join $expgui(gsasexe) exptool.exe] $expnam \
190                    < exptool.in >& exptool.out
191        } else {
192            exec [file join $expgui(gsasexe) exptool] $expnam \
193                    < exptool.in >& exptool.out
194        }
[113]195    } errmsg
[92]196    # load the revised exp file
[447]197    set oldphaselist $expmap(phaselist)
[92]198    loadexp $expgui(expfile)
199    set fp [open exptool.out r]
200    set out [read $fp]
201    close $fp
202    destroy $np
[447]203    set err 0
204    if {[llength $oldphaselist] == [llength $expmap(phaselist)]} {set err 1}
[113]205    if {$errmsg != ""} {
[447]206        set err 1
[113]207        append errmsg "\n" $out
208    } else {
209        set errmsg $out
210    }
[447]211    if {$expgui(showexptool) || $err} {
212        set msg "Please review the result from adding the phase" 
213        if {$err} {append msg "\nIt appears an error occurred!"}
214        ShowBigMessage $np $msg $errmsg OK "" $err
[321]215    }
[92]216    file delete exptool.in exptool.out
[668]217    # set the powpref warning (2 = required)
218    set expgui(needpowpref) 2
219    set msg "A phase was added" 
220    if {[string first $msg $expgui(needpowpref_why)] == -1} {
221        append expgui(needpowpref_why) "\t$msg\n"
222    }
[237]223    # now select the new phase
224    SelectOnePhase [lindex $expmap(phaselist) end]   
[92]225}
226
[447]227#----------- Add Histogram routines --------------------------------------
[668]228proc LabelInstParm {args} {
229    global newhist
230    switch $newhist(insttype) {
231        TOF {
232            set newhist(instfiletext) "Neutron Time of Flight"
233            catch {
234                set b $newhist(setnum)
235                append newhist(instfiletext) ", 2theta = $newhist(inst${b}Angle)"
236            }
237        }
238        ED {set newhist(instfiletext) "X-ray Energy Dispersive"}
239        "CW X" {set newhist(instfiletext) "CW X-ray"}
240        "CW N" {set newhist(instfiletext) "CW Neutron"}
241    }
242}
243trace variable newhist(setnum) w LabelInstParm
[92]244proc MakeAddHistBox {} {
245    global expmap newhist
246
247    # --> should check here if room for another histogram, but only texture
248    # folks will ever need that
249
250    set np .newhist
251    catch {destroy $np}
252    toplevel $np
[321]253    bind $np <Key-F1> "MakeWWWHelp expgui3.html AddHist"
[92]254
[447]255    grid [label $np.l0 -text "Adding a new histogram"] \
[92]256            -column 0 -row 0 -sticky ew -columnspan 7
[447]257    grid [checkbutton $np.d0 -text "Dummy Histogram" -variable newhist(dummy) \
258            -command "PostDummyOpts $np" \
259            ] -column 2 -row 0 -columnspan 99 -sticky e
260    grid [label $np.l1 -text "Data file:"] -column 0 -row 2
[132]261    grid [label $np.t1 -textvariable newhist(rawfile) -bd 2 -relief ridge] \
[447]262            -column 1 -row 2 -columnspan 3 -sticky ew
[92]263    grid [button $np.b1 -text "Select File" \
264            -command "getrawfile $np" \
[447]265            ] -column 4 -row 2
[92]266
[447]267    grid [label $np.lbank -text "Select bank" -anchor w] -column 1 -row 3 -sticky w
268    grid [frame $np.bank]  -column 2 -row 3 -columnspan 7 -sticky ew
[92]269
[447]270    grid [label $np.l2 -text "Instrument\nParameter file:"] -column 0 -row 5
[132]271    grid [label $np.t2 -textvariable newhist(instfile) -bd 2 -relief ridge] \
[447]272            -column 1 -row 5 -columnspan 3 -sticky ew
[92]273    grid [button $np.b2 -text "Select File" \
274            -command "getinstfile $np" \
[447]275            ] -column 4 -row 5
[694]276    grid [button $np.edit -text "Edit file" \
277            -command {EditInstFile $newhist(instfile)}] \
278            -column 5 -row 5
[92]279
[447]280    grid [label $np.lset -text "Select set" -anchor w] -column 1 -row 6 -sticky w
281    grid [frame $np.set]  -column 2 -row 6 -columnspan 7 -sticky ew
[668]282    grid [label $np.t2a -textvariable newhist(instfiletext) \
283            -justify center -anchor center -fg blue] \
284            -column 0 -row 8 -columnspan 99 -sticky ew
[92]285
[668]286    grid [button $np.f6a -text "Run\nRAWPLOT" -command "RunRawplot $np"] \
287            -column 4 -row 18 -rowspan 2
288    grid [label $np.l3 -text "Usable data limit:"] -column 0 -row 18 -rowspan 3 
[92]289    grid [entry $np.e3 -width 12 -textvariable newhist(2tLimit) \
[668]290            ] -column 1 -row 18 -rowspan 3
[92]291    grid [radiobutton $np.cb3 -text "D-min" -variable newhist(LimitMode) \
[668]292            -value 0] -column 2 -row 18 -sticky w
[447]293    grid [radiobutton $np.cb4 -textvariable newhist(limitLbl)  \
[394]294            -variable newhist(LimitMode) -anchor w -justify l \
[668]295            -value 1] -column 2 -row 20 -sticky w
296    grid [radiobutton $np.cb5 -text "Q-max" -variable newhist(LimitMode) \
297            -value 2] -column 2 -row 19 -sticky w
[447]298    set newhist(limitLbl) "TOF-min\n2-Theta Max"
299    # spacers
300    grid [frame $np.sp0 -bg white] \
301            -columnspan 20 -column 0 -row 1 -sticky nsew -ipady 2
302    grid [frame $np.sp1 -bg white] \
303            -columnspan 20 -column 0 -row 4 -sticky nsew -ipady 2
304    grid [frame $np.sp2 -bg white] \
[668]305            -columnspan 20 -column 0 -row 17 -sticky nsew -ipady 2
[447]306    grid [frame $np.sp3 -bg white] \
307            -columnspan 20 -column 0 -row 98 -sticky nsew -ipady 2
308    grid [frame $np.f6] -column 0 -row 99 -columnspan 5 -sticky ew
[92]309    grid [button $np.f6.b6a -text Add \
310            -command "addhist $np"] -column 0 -row 0
311    bind $np <Return> "addhist $np"
312    grid [button $np.f6.b6b -text Cancel \
313            -command "destroy $np"] -column 1 -row 0
[321]314    grid [button $np.f6.help -text Help -bg yellow \
315            -command "MakeWWWHelp expgui3.html AddHist"] \
316            -column 2 -row 0 -sticky e
317    grid columnconfigure $np.f6 2 -weight 1
[447]318    grid columnconfigure $np 3 -weight 1
[167]319
[447]320    # dummy histogram stuff
321    frame $np.d1
322    grid [label $np.d1.l1 -text min] -col 1 -row 1
323    grid [label $np.d1.l2 -text max] -col 2 -row 1
324    grid [label $np.d1.l3 -text step] -col 3 -row 1
325    grid [label $np.d1.lu -text ""] -col 4 -row 1 -rowspan 2
326    grid [entry $np.d1.e1 -width 10 -textvariable newhist(tmin)] -col 1 -row 2
327    grid [entry $np.d1.e2 -width 10 -textvariable newhist(tmax)] -col 2 -row 2
328    grid [entry $np.d1.e3 -width 10 -textvariable newhist(tstep)] -col 3 -row 2
329    grid [label $np.d1.m1 -anchor w] -col 1 -row 3 -sticky ew
330    grid [label $np.d1.m2 -anchor w] -col 2 -row 3 -sticky ew
331    label $np.dl1 -text "Data range:"
332    label $np.dl2 -text "Allowed"
333    label $np.dl3 -text "\n" -justify left -fg blue
[92]334    wm title $np "add new histogram"
335
[447]336    set newhist(banknum) {}
337    set newhist(setnum) {}
[92]338    if {[string trim $newhist(rawfile)] != {}} {
339        validaterawfile $np $newhist(rawfile)
340    }
341    if {[string trim $newhist(instfile)] != {}} {
342        validateinstfile $np $newhist(instfile)
343    }
344
[447]345    PostDummyOpts $np
[326]346    # set grab, etc.
[92]347    putontop $np
348
349    tkwait window $np
350
[326]351    # fix grab...
[92]352    afterputontop
353}
354
355# convert a file to Win-95 direct access
[383]356proc WinCvt {file win} {
[92]357    global expgui
358    if ![file exists $file] {
[383]359        MyMessageBox -parent $win -title "Convert Error" \
360                -message "File $file does not exist" -icon error
[92]361        return
362    }
363
364    set tmpname "[file join [file dirname $file] tempfile.xxx]"
365    set oldname "[file rootname $file].org"
366    if [file exists $oldname] {
[383]367        set ans [MyMessageBox -parent $win -title "OK to overwrite?" \
368                -message "File [file tail $oldname] exists in [file dirname $oldname]. OK to overwrite?" \
369                -icon question -type yesno -default yes]
370        if {$ans == "no"} return
[92]371        catch {file delete $oldname}
372    }
373
374    if [catch {
375        set in [open $file r]
376        # needed to test under UNIX
377        set out [open $tmpname w]
378        fconfigure $out -translation crlf
379        set len [gets $in line]
380        if {$len > 160} {
[668]381            # this is an old-style UNIX file. Hope there are no control characters
[92]382            set i 0
383            set j 79
384            while {$j < $len} {
385                puts $out [string range $line $i $j]
386                incr i 80
387                incr j 80
388            }
389        } else {
390            while {$len >= 0} {
391                append line "                                        "
392                append line "                                        "
393                set line [string range $line 0 79]
394                puts $out $line
395                set len [gets $in line]
396            }
397        }
398        close $in
399        close $out
400        file rename $file $oldname
401        file rename $tmpname $file
402    } errmsg] {
[383]403        MyMessageBox -parent $win -title Notify \
404                -message "Error in conversion:\n$errmsg" -icon warning
[92]405    }
406    return $file
407}
408
409proc getrawfile {np} {
410    global newhist tcl_platform
411    if {$tcl_platform(platform) == "windows"} {
412        set inp [
413        tk_getOpenFile -parent $np -initialfile $newhist(rawfile) -filetypes {
414            {"Data files" .GSAS} {"Data files" .GSA} 
415            {"Data files" .RAW}  {"All files" *}
416        }
417        ]
418    } else {
419        set inp [
420        tk_getOpenFile -parent $np -initialfile $newhist(rawfile) -filetypes {
421            {"Data files" .GSA*} {"Data files" .RAW} 
422            {"Data files" .gsa*} {"Data files" .raw} 
423            {"All files" *}
424        } 
425        ]
426    }
427    validaterawfile $np $inp
428}
429
430proc validaterawfile {np inp} {
[383]431    global expgui newhist
[92]432    if {$inp == ""} return
433    if [catch {set in [open $inp r]}] {
[383]434        MyMessageBox -parent $np -title "Open error" \
435                -message "Unable to open file $inp" -icon error
[92]436        return 
437    }
438    set newhist(banklist) {}
[354]439    foreach child [winfo children $np.bank] {destroy $child}
[92]440    # is this a properly formatted file?
[383]441    # -- are lines the correct length & terminated with a CR-LF?   
442    fconfigure $in -translation lf
443    set i 0
444    while {[set len [gets $in line]] > 0} {
445        incr i
446        if {$len != 81 || [string range $line end end] != "\r"} {
447            set ans [MyMessageBox -parent $np -title "Convert?" \
448                    -message "File $inp is not in the correct format for GSAS.\nOK to convert?" \
449                    -icon warning -type {OK Quit} -default OK]
450            if {$ans == "ok"} {
451                # convert and reopen the file
[92]452                close $in
[383]453                WinCvt $inp $np
454                set i 0
[92]455                set in [open $inp r]
[383]456                fconfigure $in -translation lf
[92]457                set line {}
458            } else {
459                return
460            }
461        }
[383]462        # scan for BANK lines
463        if {[string first BANK $line] == 0} {
464            scan $line "BANK%d" num
465            lappend newhist(banklist) $num
466            # compute last point
[394]467            set tmin 0
[383]468            set tmax 0
469            catch {
470                scan $line "BANK%d%d%d%s%f%f" num nchan nrec rest start step
[394]471                set tmin [expr $start/100.]
[383]472                set tmax [expr ($start + $step*($nchan-1))/100.]
[92]473            }
[394]474            set newhist(tmin$num) $tmin
[383]475            set newhist(tmax$num) $tmax
[92]476        }
[383]477        # check for "Instrument parameter file" line
478        if {$i == 2 && [string first "Instrument parameter" $line] == 0} {
479            validateinstfile $np \
480                    [file join [file dirname $inp] \
481                    [string trim [string range $line 26 end]]]
482        }
[92]483    }
484    # were banks found?
485    if {$newhist(banklist) == ""} {
[383]486        MyMessageBox -parent $np -title "Read error" \
487                -message "File $inp has no BANK lines.\nThis is not a valid GSAS data file." \
488                -icon warning
[92]489        return
490    }
[132]491    # don't use a full path unless needed
492    if {[pwd] == [file dirname $inp]} {
493        set newhist(rawfile) [file tail $inp]
494    } else {
495        set newhist(rawfile) $inp
496    }
[354]497    set row 0
498    set col -1
[92]499    foreach i $newhist(banklist) {
[354]500        if {$col > 8} {
501            set col -1
502            incr row
503        }
504        grid [radiobutton $np.bank.$i -text $i -command SetTmax \
505                -variable newhist(banknum) -value $i] \
506                -column [incr col] -row $row -sticky w
[132]507        # only 1 choice, so set it
[354]508        if {[llength $newhist(banklist)] == 1} {
509            set newhist(banknum) $i
510            SetTmax
511        } else {
512            set newhist(2tLimit) {}
513            set newhist(LimitMode) {}
514        }
[92]515    }
516}
517
[354]518proc SetTmax {} {
519    global newhist
520    set num $newhist(banknum)
[394]521    if {$newhist(insttype) == "TOF"} {
[668]522        set newhist(2tLimit) [expr {$newhist(tmin$num) / 10.}]
[394]523        if {[llength $newhist(banklist)] == $newhist(instbanks)} {
524            set newhist(setnum) $newhist(banknum)
525        }
526    } else {
527        set newhist(2tLimit) $newhist(tmax$num)
528    }
[354]529    set newhist(LimitMode) 1
[394]530
[354]531}
532
[92]533proc getinstfile {np} {
534    global newhist tcl_platform
535    if {$tcl_platform(platform) == "windows"} {
536        set inp [
537        tk_getOpenFile -parent $np -initialfile $newhist(instfile) -filetypes {
538            {"Inst files" .INST} {"Inst files" .INS} 
539            {"Inst files" .PRM} {"All files" *}
540        }
541        ]
542    } else {
543        set inp [
544        tk_getOpenFile -parent $np -initialfile $newhist(instfile) -filetypes {
545            {"Inst files" .INS*} {"Inst files" .ins*} 
546            {"Inst files" .PRM}  {"Inst files" .prm} 
547            {"All files" *}
548        }
549        ]
550    }
[447]551    set newhist(setnum) {}
[92]552    validateinstfile $np $inp
553}
554
555proc validateinstfile {np inp} {
[383]556    global expgui newhist
[92]557    if {$inp == ""} return
558    if [catch {set in [open $inp r]}] {
[383]559        MyMessageBox -parent $np -title "Open error" \
560                -message "Unable to open file $inp" -icon error
[92]561        return 
562    }
563    set newhist(instbanks) {}
[354]564    foreach child [winfo children $np.set] {destroy $child}
[92]565    # is this a properly formatted file?
[383]566    # -- are lines the correct length & terminated with a CR-LF?   
567    fconfigure $in -translation lf
568    while {[set len [gets $in line]] > 0} {
569        if {$len != 81 || [string range $line end end] != "\r"} {
570            set ans [MyMessageBox -parent $np -title "Convert?" \
571                    -message "File $inp is not in the correct format for GSAS.\nOK to convert?" \
572                    -icon warning -type {OK Quit} -default OK]
573            if {$ans == "ok"} {
574                # convert and reopen the file
[92]575                close $in
[383]576                WinCvt $inp $np
[92]577                set in [open $inp r]
[383]578                fconfigure $in -translation lf
[92]579                set line {}
580            } else {
581                return
582            }
583        }
[383]584        # scan for the INS   BANK line
585        if {[string first "INS   BANK" $line] == 0} {
586            set newhist(instbanks) \
587                    [string trim [string range $line 12 end]]
[92]588        }
[668]589        # scan for the INS   HTYPE line
[394]590        if {[string first "INS   HTYPE" $line] == 0} {
591            if {[string index [lindex $line 2] 2] == "T"} {
592                set newhist(insttype) TOF
593            } elseif {[string index [lindex $line 2] 2] == "E"} {
594                set newhist(insttype) ED
[668]595            } elseif {[string index [lindex $line 2] 1] == "X"} {
596                set newhist(insttype) "CW X"
[394]597            } else {
[668]598                set newhist(insttype) "CW N"
[394]599            }
600        }
[447]601        # scan for the instrument constants
602        if {[regexp {INS ([ 1-9][0-9]) ICONS(.*)} $line a b c]} {
603            set b [string trim $b]
604            set newhist(inst${b}ICONS) [string trim $c]
605        }
606        if {[regexp {INS ([ 1-9][0-9])I ITYP(.*)} $line a b c]} {
607            set b [string trim $b]
608            set newhist(inst${b}ITYP) [string trim $c]
609        }
[668]610        if {[regexp {INS ([ 1-9][0-9])BNKPAR(.*)} $line a b c]} {
611            set b [string trim $b]
612            set newhist(inst${b}Angle) [string trim [lindex $c 1]]
613        }
[92]614    }
615    # were banks found?
616    if {$newhist(instbanks) == ""} {
[383]617        MyMessageBox -parent $np -title "Read error" -message \
618                "File $inp has no \"INS   BANK\" line.\nThis is not a valid GSAS Instrument Parameter file." \
619                -icon warning
[92]620        return
621    }
[132]622    # don't use a full path unless needed
623    if {[pwd] == [file dirname $inp]} {
624        set newhist(instfile) [file tail $inp]
625    } else {
626        set newhist(instfile) $inp
627    }
[354]628    set col -1
629    set row 0
[92]630    for {set i 1} {$i <= $newhist(instbanks)} {incr i} {
[354]631        if {$col > 8} {
632            set col -1
633            incr row
634        }
635        grid [radiobutton $np.set.$i -text $i \
[447]636                -command "PostDummyOpts $np; ValidateDummyHist $np" \
[354]637                -variable newhist(setnum) -value $i] \
638                -column [incr col] -row $row -sticky w
[132]639        if {$newhist(instbanks) == 1} {set newhist(setnum) $i}
[92]640    }
[447]641    if {$newhist(dummy)} {PostDummyOpts $np; ValidateDummyHist $np}
[668]642    LabelInstParm
[92]643}
644
645proc addhist {np} {
[447]646    global expgui newhist tcl_platform expmap
647    if {$newhist(dummy)} {
648        AddDummyHist $np
649        return
650    }
[92]651    # validate the input
652    set err {}
653    if {[string trim $newhist(rawfile)] == ""} {
654        append err "  No data file specified\n"
655    }
656    if {[string trim $newhist(instfile)] == ""} {
657        append err "  No instrument parameter file specified\n"
658    }
659    if {[string trim $newhist(banknum)] == ""} {
660            append err "  Bank number must be specified\n"
661    } elseif {[catch {expr $newhist(banknum)}]} {
662            append err "  Bank number is not valid\n"
663    }
664    if {[string trim $newhist(setnum)] == ""} {
665        append err "  Parameter set number must be specified\n"
666    } elseif {[catch {expr $newhist(setnum)}]} {
667        append err "  Parameter set number is not valid\n"
668    }
669    if {[string trim $newhist(2tLimit)] == ""} {
670        append err "  2Theta/d-space limit must be specified\n"
671    } elseif {[catch {expr $newhist(2tLimit)}]} {
672        append err "  The 2Theta/d-space limit is not valid\n"
[668]673    } elseif {$newhist(2tLimit) <= 0} {
674        append err "  The 2Theta/d-space limit is not valid\n"
[92]675    }
676    if {[string trim $newhist(LimitMode)] == ""} {
[668]677        append err "  Please choose between either a 2Theta, Q or d-space limit\n"
[92]678    }
679
680    if {$err != ""} {
[321]681        MyMessageBox -parent $np -title  "Add Histogram Error" \
682                -message "The following error(s) were found in your input:\n$err" \
683                -icon error -type ok -default ok \
684                -helplink "expgui3.html AddHistErr"
[92]685        return
686    }
687
688    # ok do it!
689    set fp [open exptool.in w]
690    puts $fp "H"
[232]691    if {$tcl_platform(platform) == "windows"} {
692        puts $fp [file attributes $newhist(rawfile) -shortname]
693        puts $fp [file attributes $newhist(instfile) -shortname]
694    } else {
695        puts $fp $newhist(rawfile)
696        puts $fp $newhist(instfile)
697    }
[92]698    puts $fp $newhist(banknum)
699    puts $fp $newhist(setnum)
[668]700    if {$newhist(LimitMode) == 1} {
[92]701        puts $fp "T"
[668]702        puts $fp "$newhist(2tLimit)"
703    } elseif {$newhist(LimitMode) == 2} {
704        puts $fp "D"
705        set Q 100
706        catch {set Q [expr {4*acos(0)/$newhist(2tLimit)}]}
707        puts $fp "$Q"
[92]708    } else {
709        puts $fp "D"
[668]710        puts $fp "$newhist(2tLimit)"
[92]711    }
712    puts $fp "/"
713    puts $fp "X"
714    puts $fp "X"
715    close $fp
716    global tcl_platform
717    # Save the current exp file
718    savearchiveexp
719    # disable the file changed monitor
720    set expgui(expModifiedLast) 0
721    set expnam [file root [file tail $expgui(expfile)]]
722    catch {
723        if {$tcl_platform(platform) == "windows"} {
724            exec [file join $expgui(gsasexe) exptool.exe] $expnam \
725                    < exptool.in >& exptool.out
726        } else {
727            exec [file join $expgui(gsasexe) exptool] $expnam \
728                    < exptool.in >& exptool.out
729        }
[113]730    } errmsg
[92]731    # load the revised exp file
[447]732    set oldpowderlist $expmap(powderlist)
[92]733    loadexp $expgui(expfile)
734    set fp [open exptool.out r]
735    set out [read $fp]
736    close $fp
737    destroy $np
[447]738    set err 0
739    if {[llength $oldpowderlist] == [llength $expmap(powderlist)]} {set err 1}
[113]740    if {$errmsg != ""} {
741        append errmsg "\n" $out
[447]742        set err 1
[113]743    } else {
744        set errmsg $out
745    }
[447]746    if {$expgui(showexptool) || $err} {
747        set msg "Please review the result from adding the histogram" 
748        if {$err} {append msg "\nIt appears an error occurred!"}
749        ShowBigMessage $np $msg $errmsg OK "" $err
[321]750    }
[92]751    file delete exptool.in exptool.out
[668]752    # set the powpref warning (2 = required)
753    set expgui(needpowpref) 2
754    set msg "A histogram was added" 
755    if {[string first $msg $expgui(needpowpref_why)] == -1} {
756        append expgui(needpowpref_why) "\t$msg\n"
757    }
758    # select the most recently added histogram
759    if {!$err} {
760        set i [llength $expmap(histlistboxcontents)]
761        if {$i > 0} {
762            incr i -1
763            set expgui(curhist) $i
764            sethistlist
765        }
766    }
[92]767}
768
[668]769proc RunRawplot {parent} {
[232]770    global newhist tcl_platform
[668]771    set f1 $newhist(rawfile)
772    set f2 $newhist(instfile)
[232]773    # for Windows put a message on top, in case file names must be shortened
774    if {$tcl_platform(platform) == "windows"} {
775        catch {set f1 [file nativename \
776                    [file attributes $newhist(rawfile) -shortname]]}
777        catch {set f2 [file nativename \
778                [file attributes $newhist(instfile) -shortname]]}
779    }
[668]780    if {$f1 != "" || $f2 != ""} {
781        #set msg "Note: input to RAWPLOT\n"
782        #if {$f1 != ""} {append msg "data file: $f1\n"}
783        #if {$f2 != ""} {append msg "instrument file: $f2"}
784        catch {toplevel $parent.msg}
785        catch {eval destroy [winfo children $parent.msg]}
786        wm title $parent.msg "File names"
787        grid [label $parent.msg.1 \
788                -text "File names to be input to RAWPLOT" \
789                -justify center -anchor center] \
790                -col 0 -row 0 -columnspan 2
791        if {$f1 != ""} {
792            grid [label $parent.msg.2a \
793                    -text "Raw histogram: $f1" \
794                    -justify center -anchor e] \
795                    -col 0 -row 1
796            grid [button $parent.msg.2b \
797                    -command "clipboard clear; clipboard append $f1" \
798                    -text "put name\nin clipboard"] \
799                    -col 1 -row 1
800        }           
801        if {$f2 != ""} {
802            grid [label $parent.msg.3a \
803                    -text "Raw histogram: $f2" \
804                    -justify center -anchor e] \
805                    -col 0 -row 2
806            grid [button $parent.msg.3b \
807                    -command "clipboard clear; clipboard append $f2" \
808                    -text "put name\nin clipboard"] \
809                    -col 1 -row 2
810        }           
811        grid [button $parent.msg.4 \
812                -command "destroy $parent.msg" \
813                -text "Close"] \
814                -col 0 -columnspan 2 -row 9
815    }
[232]816    # start RAWPLOT
[358]817    runGSASprog rawplot 1
[668]818    if {[winfo exists $parent.msg]} {raise $parent.msg}
819    update
[232]820}
[447]821#--- Dummy histogram stuff
822proc PostDummyOpts {np} {
823    global newhist
824    if {$newhist(dummy)} {
825        trace variable newhist(tmin) w "ValidateDummyHist $np"
826        trace variable newhist(tmax) w "ValidateDummyHist $np"
827        trace variable newhist(tstep) w "ValidateDummyHist $np"
828        foreach w {l1 t1 lbank} {
829            $np.$w config -fg grey
830        }
[458]831        $np.d1.m1 config -text {}
832        $np.d1.m2 config -text {}
[447]833        $np.b1 config -state disabled
[668]834        grid forget $np.l3 $np.e3 $np.cb3 $np.cb4 $np.cb5 $np.bank $np.f6a
835        grid $np.dl1 -column 0 -row 18
836        grid $np.d1 -column 1 -row 18 -rowspan 2 -columnspan 4 -sticky e
837        grid $np.dl3 -column 0 -columnspan 99 -row 20 -sticky ew
[447]838        if {$newhist(insttype) == "TOF"} {
839            $np.dl1 config -text "Data range:\n(TOF)"
840            $np.d1.lu config -text millisec
[668]841            grid $np.dl2 -column 0 -row 19
[447]842            catch {
[472]843                set s $newhist(setnum)
844                foreach {x tmin tmax x} $newhist(inst${s}ITYP) {}
[447]845                $np.d1.m1 config -text $tmin
846                $np.d1.m2 config -text $tmax
847            }
[668]848        } elseif {[lindex $newhist(insttype) 0] == "CW"} {
[447]849            $np.dl1 config -text "Data range:\n(2Theta)"
850            $np.d1.lu config -text degrees
851            #grid forget $np.dl2
852            $np.d1.m1 config -text >0.
853            $np.d1.m2 config -text <180.
[458]854        } elseif {$newhist(insttype) == "ED"} {
[447]855            $np.dl1 config -text "Data range:\n(Energy)"
856            $np.d1.lu config -text KeV
857            $np.d1.m1 config -text 1.
858            $np.d1.m2 config -text 200.
[668]859            grid $np.dl2 -column 0 -row 19
[458]860        } else {
861            $np.dl1 config -text "No file\nselected"
862            $np.d1.lu config -text {}
[447]863        }
864    } else {
865        foreach var {tmin tmax tstep} {
866            foreach v [ trace vinfo newhist($var)] {
867                eval trace vdelete newhist($var) $v
868            }
869        }
870        grid forget $np.dl1 $np.d1 $np.dl2 $np.dl3
871        foreach w {l1 t1 lbank} {
872            $np.$w config -fg black
873        }
874        $np.b1 config -state normal
875        grid $np.bank -column 2 -row 3 -columnspan 7 -sticky ew
[668]876        grid $np.f6a -column 4 -row 18 -rowspan 3
877        grid $np.l3 -column 0 -row 18 -rowspan 3
878        grid $np.e3 -column 1 -row 18 -rowspan 3 
879        grid $np.cb3 -column 2 -row 18 -sticky w
880        grid $np.cb4 -column 2 -row 20 -sticky w
881        grid $np.cb5 -column 2 -row 19 -sticky w
[447]882     }
883}
[232]884
[447]885proc ValidateDummyHist {np args} {
886    # validate input
887    global newhist
888    set msg {}
889    $np.dl3 config -text "\n"
890    foreach e {e1 e2 e3} v {tmin tmax tstep} {
891        if [catch {expr $newhist($v)}] {
892            $np.d1.$e config -fg red
893            append msg "Value of $newhist($v) is invalid for $v\n"
894        } else {
895            $np.d1.$e config -fg black
896        }
897    }
898    if {[catch {expr $newhist(setnum)}]} {
899        append msg "An instrument file bank number must be selected\n"
900    } elseif {$newhist(setnum) <= 0 || \
901            $newhist(setnum) > $newhist(instbanks)} {
902        append msg "An invalid instrument file bank has been selected\n"
903    }
904
905    if {$msg != ""} {return $msg}
906
907    if {$newhist(tmax) <= $newhist(tmin)} {
908        $np.d1.e1 config -fg red
909        $np.d1.e2 config -fg red
910        return "Tmax <= Tmin\n"
911    }
912
913
914    set dmin -1
915    set dmax -1
916    if {$newhist(insttype) == "TOF"} {
917        catch {
[472]918            set s $newhist(setnum)
919            foreach {x tmin tmax x} $newhist(inst${s}ITYP) {}
[447]920            if {$newhist(tmin) <$tmin } {
921                $np.d1.e1 config -fg red
922                append msg "Min value of $newhist(tmin) msec is invalid.\n"
923            }
924            if {$newhist(tmax) >$tmax } {
925                $np.d1.e2 config -fg red
926                append msg "Max value of $newhist(tmax) msec is invalid.\n"
927            }
[472]928            set s $newhist(setnum)
[447]929            set dmin [expr {1000. * $newhist(tmin) / \
[472]930                    [lindex $newhist(inst${s}ICONS) 0]}]
[447]931            set dmax [expr {1000. * $newhist(tmax) / \
[472]932                    [lindex $newhist(inst${s}ICONS) 0]}]
[447]933        }
[668]934    } elseif {[lindex $newhist(insttype) 0] == "CW"} {
[447]935        if {$newhist(tmin) <= 0 } {
936            $np.d1.e1 config -fg red
937            append msg "Min value of $newhist(tmin) degrees is invalid.\n"
938        }
939        if {$newhist(tmax) >=180 } {
940            $np.d1.e2 config -fg red
941            append msg "Max value of $newhist(tmax) degrees is invalid.\n"
942        }
943        catch {
[472]944            set s $newhist(setnum)
945            set dmin [expr {[lindex $newhist(inst${s}ICONS) 0]\
[447]946                    * 0.5 / sin(acos(0.)*$newhist(tmax)/180.)}]
[472]947            set dmax [expr {[lindex $newhist(inst${s}ICONS) 0]\
[447]948                    * 0.5 / sin(acos(0.)*$newhist(tmin)/180.)}]
949        }
950    } else {
951        if {$newhist(tmin) <1 } {
952            $np.d1.e1 config -fg red
953            append msg "Min value of $newhist(tmin) KeV is invalid.\n"
954        }
955        if {$newhist(tmax) >200 } {
956            $np.d1.e2 config -fg red
957            append msg "Max value of $newhist(tmax) KeV is invalid.\n"
958        }
959        catch {
[472]960            set s $newhist(setnum)
961            set ang [lindex $newhist(inst${s}ICONS) 0]
[447]962            set dmin [expr {12.398/ (2.0*sin($ang*acos(0.)/180) * \
963                    $newhist(tmax))}]
964            set dmax [expr {12.398/ (2.0*sin($ang*acos(0.)/180) * \
965                    $newhist(tmin))}]
966        }
967    }
968    if {$msg != ""} {return $msg}
969    set pnts -1
970    catch {
971        set pnts [expr {1+int(($newhist(tmax) - $newhist(tmin))/$newhist(tstep))}]
972        set qmin [expr {4.*acos(0)/$dmax}]
973        set qmax [expr {4.*acos(0)/$dmin}]
974    }
975    if {$pnts <= 0} {
976        $np.d1.e3 config -fg red
977        append msg "Step value of $newhist(tstep) is invalid.\n"
978    }
979    if {$pnts >20000} {
980        $np.d1.e3 config -fg red
981        append msg "Step value of $newhist(tstep) is too small (>20000 points).\n"
982    }
983    if {$msg != ""} {return $msg}
984    if {$dmin > 0 && $dmax > 0} {
985        catch {
986            set msg [format \
987                    {  %d points.%s  D-space range: %.2f-%.2f A,  Q: %.2f-%.2f/A} \
988                    $pnts "\n" $dmin $dmax $qmin $qmax]
989            $np.dl3 config -text $msg
990        }
991    }
992    if {$msg != ""} {return ""}
993    $np.dl3 config -text [format {  %d points.%s  Range: ?} $pnts "\n"]
994    return "Invalid data range -- something is wrong!"
995}
996
997proc AddDummyHist {np} {
998    global newhist expgui expmap
999    global tcl_platform
1000    set msg [ValidateDummyHist $np]
1001    if {$msg != ""} {
1002        MyMessageBox -parent $np -title  "Add Histogram Error" \
1003                -message "The following error(s) were found in your input:\n$msg" \
1004                -icon error -type ok -default ok \
1005                -helplink "expgui3.html AddHistErr"
1006        return
1007    }
1008    set fp [open exptool.in w]
1009    puts $fp "D"
1010    puts $fp $newhist(instfile)
1011    puts $fp $newhist(setnum)
1012    if {$newhist(insttype) == "TOF"} {
1013        puts $fp "C"
1014    }
1015    puts $fp $newhist(tmin)
1016    puts $fp $newhist(tmax)
1017    puts $fp $newhist(tstep)
1018    puts $fp "X"
1019    puts $fp "0"
1020    close $fp
1021    # Save the current exp file
1022    savearchiveexp
1023    # disable the file changed monitor
1024    set expgui(expModifiedLast) 0
1025    set expnam [file root [file tail $expgui(expfile)]]
1026    set err [catch {
1027        if {$tcl_platform(platform) == "windows"} {
1028            exec [file join $expgui(gsasexe) exptool.exe] $expnam \
1029                    < exptool.in >& exptool.out
1030        } else {
1031            exec [file join $expgui(gsasexe) exptool] $expnam \
1032                    < exptool.in >& exptool.out
1033        }
1034    } errmsg ]
1035    # load the revised exp file
1036    set oldpowderlist $expmap(powderlist)
1037    loadexp $expgui(expfile)
1038    set fp [open exptool.out r]
1039    set out [read $fp]
1040    close $fp
1041    if {[llength $oldpowderlist] == [llength $expmap(powderlist)]} {set err 1}
1042    if {$errmsg != ""} {
1043        append errmsg "\n" $out
1044    } else {
1045        set errmsg $out
1046    }
1047    if {[regexp {\(P,H,A\)} $out]} {
1048        set msg {You must upgrade the EXPTOOL program.}
1049        append msg { This version cannot add dummy histograms.}
1050        MyMessageBox -icon error -title "Old EXPTOOL program" \
1051                -message $msg -parent $np \
1052                -helplink "expguierr.html OldEXPTOOL"
1053        # update the documentation & link
1054        destroy $np
1055    } elseif {$expgui(showexptool) || $err} {
1056        set msg "Please review the result from adding the dummy histogram" 
1057        if {$err} {append msg "\nIt appears an error occurred!"}
1058        ShowBigMessage $np $msg $errmsg OK "" $err
1059    } else {
1060        destroy $np
1061    }
1062    file delete exptool.in exptool.out
[668]1063    # set the powpref warning (2 = required)
1064    set expgui(needpowpref) 2
1065    set msg "A histogram was added" 
1066    if {[string first $msg $expgui(needpowpref_why)] == -1} {
1067        append expgui(needpowpref_why) "\t$msg\n"
1068    }
[447]1069}
1070
1071
1072
1073#----------- Add Atoms routines ----------------------------------------
[268]1074proc MakeAddAtomsBox {phase "atomlist {}"} {
1075    global expmap expgui
[92]1076
[179]1077    # is there room for more atoms? Well, we will check this someday
[92]1078    if {$phase == ""} return
1079    if {[llength $phase] != 1} return
1080
[179]1081    set top .newatoms
1082    catch {destroy $top}
1083    toplevel $top
[321]1084    bind $top <Key-F1> "MakeWWWHelp expgui2.html addatoms"
[92]1085
[179]1086    grid [label $top.l1 -relief groove -bd 4 -anchor center\
1087            -text "Adding atoms to phase #$phase"] \
1088            -column 0 -row 0 \
1089            -sticky we -columnspan 10
1090   
1091    grid [canvas $top.canvas \
1092            -scrollregion {0 0 5000 500} -width 0 -height 250 \
1093            -yscrollcommand "$top.scroll set"] \
1094            -column 0 -row 2 -columnspan 4 -sticky nsew
1095    grid columnconfigure $top 3 -weight 1
1096    grid rowconfigure $top 2 -weight 1
1097    grid rowconfigure $top 1 -pad 5
1098    scrollbar $top.scroll \
1099            -command "$top.canvas yview"
1100    frame $top.canvas.fr
1101    $top.canvas create window 0 0 -anchor nw -window $top.canvas.fr
1102
1103    set np $top.canvas.fr
1104    set row 0
1105    set col 0
[379]1106    grid [label $np.l_${row}0 -text "  #  "] -column $col -row $row
1107    foreach i {Atom\ntype Name x y z Occ Uiso} \
1108            var {type name x y z occ uiso} {
1109        grid [button $np.l_${row}$i -text $i -padx 0 -pady 0 \
1110                -command "sortAddAtoms $phase $top $var"] \
1111                -column [incr col] -row $row -sticky nsew
[92]1112    }
[379]1113    grid [label $np.l_${row}Use -text Use\nFlag] -column [incr col] -row $row
[92]1114
[179]1115    set expgui(SetAddAtomsScroll) 0
[268]1116    set i [llength $atomlist]
1117    if {$i == 0} {incr i}
1118    for {set j 0} {$j < $i} {incr j} {
1119        MakeAddAtomsRow $top
1120    }
1121    set row 0
1122    foreach item $atomlist {
1123        incr row
1124        foreach val $item w {n x y z t o u} {
1125            if {$val != ""} {
1126                $np.e${row}$w delete 0 end
1127                $np.e${row}$w insert end $val
1128            }
1129        }
1130    }
[179]1131    bind $top <Configure> "SetAddAtomsScroll $top"
[268]1132    grid rowconfigure $top 3 -min 10
[179]1133    grid [button $top.b1 -text "Add Atoms"\
[268]1134            -command "addatom $phase $top"] -column 0 -row 5 -sticky w
[179]1135    bind $top <Return> "addatom $phase $top"
1136    grid [button $top.b2 -text Cancel \
[268]1137            -command "destroy $top"] -column 1 -row 5 -sticky w
[321]1138    grid [button $top.help -text Help -bg yellow \
1139            -command "MakeWWWHelp expgui2.html addatoms"] \
1140            -column 0 -columnspan 2 -row 4
[179]1141
[268]1142    # get the input formats if not already defined
1143    GetImportFormats
1144    if {[llength $expgui(importFormatList)] > 0} {
1145        grid [frame $top.fr -bd 4 -relief groove] \
1146                -column 3 -row 5 -columnspan 2 -sticky e
1147        grid [button $top.fr.b3 -text "Import atoms from: " \
[379]1148                -command "ImportAtoms \$expgui(importFormat) $top $phase"] \
[268]1149                -column 0 -row 0 -sticky e
[553]1150        set menu [eval tk_optionMenu $top.fr.b4 expgui(importFormat) \
1151                $expgui(importFormatList)]
1152        for {set i 0} {$i <= [$menu index end]} {incr i} {
1153            $menu entryconfig $i -command "ImportAtoms \$expgui(importFormat) $top $phase"
1154        }
[268]1155        grid $top.fr.b4 -column 1 -row 0 -sticky w
1156        grid rowconfig $top.fr 0 -pad 10
1157        grid columnconfig $top.fr 0 -pad 10
1158        grid columnconfig $top.fr 1 -pad 10
1159    }
1160
1161    grid [button $top.b3 -text  "More atom boxes" \
[179]1162            -command "MakeAddAtomsRow $top"] -column 3 \
1163            -columnspan 2 -row 4 -sticky e
1164   
1165    wm title $top "add new atom"
1166
[326]1167    # set grab, etc.
[179]1168    putontop $top
1169
1170    tkwait window $top
1171
[326]1172    # fix grab...
[179]1173    afterputontop
1174}
1175
1176proc MakeAddAtomsRow {top} {
1177    set np $top.canvas.fr
[92]1178    set col -1
[179]1179    set row 1
1180    # find an empty row
1181    while {![catch {grid info $np.e${row}t}]} {incr row}
1182    grid [label $np.e${row}num -text $row] -column [incr col]  -row $row
[92]1183    grid [entry $np.e${row}t -width 5] -column [incr col]  -row $row
1184    grid [entry $np.e${row}n -width 8] -column [incr col]  -row $row
1185    foreach i {x y z o u} {
[179]1186        grid [entry $np.e${row}$i -width 9] -column [incr col] -row $row
[92]1187    }
[179]1188    grid [checkbutton $np.e${row}use -variable expgui(UseAtom$row)] \
1189            -column [incr col] -row $row
[92]1190    # default occupancy
1191    $np.e${row}o delete 0 end
1192    $np.e${row}o insert end 1.0
1193    # default Uiso
1194    $np.e${row}u delete 0 end
1195    $np.e${row}u insert end 0.025
[268]1196    # default label
[92]1197    $np.e${row}n delete 0 end
1198    $np.e${row}n insert end (default)
[179]1199    # use by default
1200    $np.e${row}use select
[92]1201
[179]1202    SetAddAtomsScroll $top
[268]1203    return $row
[179]1204}
[92]1205
[179]1206proc SetAddAtomsScroll {top} {
1207    global expgui
1208    if $expgui(SetAddAtomsScroll) return
1209    # prevent reentrance
1210    set expgui(SetAddAtomsScroll) 1
1211    update
1212    set sizes [grid bbox $top.canvas.fr]
1213    $top.canvas config -scrollregion $sizes -width [lindex $sizes 2]
1214    # use the scroll for BIG atom lists
1215    if {[lindex $sizes 3] > [winfo height $top.canvas]} {
1216        grid $top.scroll -sticky ns -column 4 -row 2
1217    } else {
1218        grid forget $top.scroll 
1219    }
1220    update
1221    set expgui(SetAddAtomsScroll) 0
[92]1222}
1223
[536]1224# Validate the atoms in the atoms add/phase replace box
1225# returns a null string on error or a list of atoms
[553]1226proc ValidateAtomsBox {top np} {
1227    global expgui
[179]1228    set row 0
1229    # loop over the defined rows
[92]1230    set err {}
[179]1231    set atomlist {}
[378]1232    set validatmtypes {
[493]1233        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
[378]1234        B_11 C CV C_12 C_13 N N_14 N_15 O O-1 O_16 O_17 O_18 F F-1 F_19 NE
1235        NE_20 NE_21 NE_22 NA NA+1 NA_23 MG MG+2 MG_24 MG_25 MG_26 AL AL+3
1236        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
1237        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
1238        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
1239        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
1240        FE+2 FE+3 FE_54 FE_56 FE_57 FE_58 CO CO+2 CO+3 CO_59 NI NI+2 NI+3
1241        NI_58 NI_60 NI_61 NI_62 NI_64 CU CU+1 CU+2 CU_63 CU_65 ZN ZN+2 ZN_64
1242        ZN_66 ZN_67 ZN_68 GA GA+3 GE GE+4 AS AS_75 SE BR BR-1 BR_79 BR_81 KR
1243        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
1244        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
1245        AG+2 CD CD+2 CD_112 CD_113 CD_114 CD_116 IN IN+3 IN_113 IN_115 SN SN+2
1246        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
1247        CE+3 CE+4 PR PR+3 PR+4 PR_141 ND ND+3 PM PM+3 PM_147 SM SM+3 SM_152
1248        SM_154 EU EU+2 EU+3 EU_153 GD GD+3 GD_160 TB TB+3 TB_159 DY DY+3 HO
1249        HO+3 HO_165 ER ER+3 TM TM+3 TM_169 YB YB+2 YB+3 LU LU+3 HF HF+4 TA
1250        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
1251        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
1252        PO_210 AT AT_210 RN RN_222 FR FR_223 RA RA+2 RA_226 AC AC+3 AC_227 TH
1253        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
1254        NP_237 PU PU+3 PU+4 PU+6 PU_239 PU_240 PU_242 AM AM_243 CM CM_244 BK
1255        BK_247 CF CF_249
1256    }
[536]1257    # loop over the defined rows
[179]1258    while {![catch {grid info $np.e[incr row]t}]} {
1259        if !{$expgui(UseAtom$row)} continue
1260        # ignore blank entries
1261        set line {}
1262        foreach i {t x y z} {
1263            append line [string trim [$np.e${row}$i get]]
[92]1264        }
[179]1265        if {$line == ""} continue
[536]1266
[179]1267        # validate the input
1268        if {[set type [string trim [$np.e${row}t get]]] == ""} {
1269            append err "  line $row: No atom type specified\n"
1270        }
[378]1271        if {[lsearch $validatmtypes [string toupper $type]] == -1} {
1272            append err "  line $row: Atom type $type is invalid for GSAS\n"
1273        }
[179]1274        set name [string trim [$np.e${row}n get]]
1275        if {$name == "(default)"} {set name "/"}
1276        if {$name == ""} {set name "/"}
1277        foreach i {x y z o u} n {x y z Occ Uiso} {
1278            if {[set $i [string trim [$np.e${row}$i get]]] == ""} {
1279                append err "  line $row: No value specified for $n\n"
1280            } elseif {[catch {expr [set $i]}]} {
1281                append err "  line $row: The value for $n is invalid\n"
1282            }
1283        }
1284        lappend atomlist "$type $x $y $z $o $name I $u"
[536]1285    }
[92]1286    if {$err != ""} {
[179]1287        MyMessageBox -icon warning -message "Note Errors:\n$err" -parent $top
[536]1288        return {}
[92]1289    }
[179]1290    if {[llength $atomlist] == 0} {
1291        MyMessageBox -icon warning -message "No atoms to load!" -parent $top
[536]1292        return {}
[179]1293    }
[536]1294    return $atomlist
1295}
1296
1297proc addatom {phase top} {
1298    global expgui env expmap
1299    set np $top.canvas.fr
1300    # validate the atoms info
1301    set atomlist [ValidateAtomsBox $top $np]
[553]1302    if {$atomlist == ""} return
[536]1303
[179]1304    # ok add the atoms!
[92]1305    set fp [open exptool.in w]
1306    puts $fp "A"
1307    puts $fp $phase
[179]1308    # number of atoms
1309    puts $fp [llength $atomlist]
1310    foreach atomline $atomlist {
1311        puts $fp $atomline
1312    }
[92]1313    close $fp
1314    # needed in UNIX
1315    set env(ATOMDATA) [file join $expgui(gsasdir) data atmdata.dat]
[394]1316    set env(gsas) [file nativename $expgui(gsasdir)]
[92]1317    # needed in Windows
1318    set env(GSAS) [file nativename $expgui(gsasdir)]
[179]1319
[92]1320    global tcl_platform
1321    # Save the current exp file
1322    savearchiveexp
1323    # disable the file changed monitor
1324    set expgui(expModifiedLast) 0
1325    set expnam [file root [file tail $expgui(expfile)]]
1326    catch {
1327        if {$tcl_platform(platform) == "windows"} {
1328            exec [file join $expgui(gsasexe) exptool.exe] $expnam \
1329                    < exptool.in >& exptool.out
1330        } else {
1331            exec [file join $expgui(gsasexe) exptool] $expnam \
1332                    < exptool.in >& exptool.out
1333        }
[113]1334    } errmsg
[92]1335    # load the revised exp file
[447]1336    set oldatomlist $expmap(atomlist_$phase)
[92]1337    loadexp $expgui(expfile)
1338    set fp [open exptool.out r]
1339    set out [read $fp]
1340    close $fp
[179]1341    destroy $top
[447]1342    set err 0
1343    if {[llength $oldatomlist] == [llength $expmap(atomlist_$phase))]} {
1344        set err 1
1345    }
[113]1346    if {$errmsg != ""} {
1347        append errmsg "\n" $out
[447]1348        set err 1
[113]1349    } else {
1350        set errmsg $out
1351    }
[447]1352    if {$expgui(showexptool) || $err} {
1353        set msg "Please review the result from adding the atom(s)" 
1354        if {$err} {append msg "\nIt appears an error occurred!"}
1355        ShowBigMessage $top $msg $errmsg OK "" $err
[321]1356    }
[92]1357    file delete exptool.in exptool.out
1358}
[254]1359
[447]1360#---------------------------------------------------------------------------
1361# commands to modify a group of selected atoms
1362#---------------------------------------------------------------------------
[254]1363
1364# make the dialog to choose an action
1365proc MakeXformAtomsBox {phase} {
1366    global expgui expmap
1367    set numberList {}
1368    set p $expgui(curPhase)
1369    foreach AtomIndex $expgui(selectedatomlist) {
1370        # get atom number & phase
1371        set tuple [lindex $expmap(atomlistboxcontents) $AtomIndex]
1372        lappend numberList [lindex $tuple 0]
1373    }
1374    if {$numberList == ""} return
1375    if {[llength $numberList] > 1} {
1376        set suffix s
1377        set suffixy "ies"
1378    } else {
1379        set suffix ""
1380        set suffixy "y"
1381    }
1382    set w .global
1383    catch {destroy $w}
1384    toplevel $w
1385    wm title $w "Edit Atomic Parameter -- phase #$phase"
[321]1386    bind $w <Key-F1> "MakeWWWHelp expgui2.html xform"
[254]1387    # this needs to track by phase
1388    grid [label $w.0 \
1389            -text "Modifying atom${suffix} [CompressList $numberList] Phase $phase" \
1390            -bg yellow -anchor center] -row 0 -column 0 -columnspan 10 \
1391            -sticky nsew
1392    grid rowconfigure $w 0 -pad 5
1393    grid rowconfigure $w 1 -minsize 2
1394
1395    grid [TitleFrame $w.1 -bd 6 -relief groove -text "Modify coordinates"] \
1396            -row 2 -column 0 -columnspan 10 -sticky news
1397    set w1 [$w.1 getframe]
1398    set row 0
1399    foreach v {x y z} {
1400        incr row
1401        set col -1
1402        grid [label $w1.l$v -text "new $v   =   "] -column [incr col] -row $row
1403        foreach o {x y z} {
1404            grid [entry $w1.e${v}${o} -width 6] -column [incr col] -row $row
1405            $w1.e${v}${o} delete 0 end
1406            if {$v == $o} {
1407                $w1.e${v}${o} insert end "1.0"
1408            } else {
1409                $w1.e${v}${o} insert end "0."
1410            }
1411            grid [label $w1.p${v}${o} -text " $o  +  "] \
1412                    -column [incr col] -row $row
1413        }
1414        grid [entry $w1.e${v} -width 6] -column [incr col] -row $row
1415        $w1.e${v} delete 0 end
1416        $w1.e${v} insert end "0."
1417    }
1418    grid [button $w1.do -text "Transform Coordinates" \
1419            -command "XformAtomsCoord $phase [list $numberList] $w1" \
1420            ] -row [incr row] -column 0 -columnspan 10
1421
1422    grid rowconfigure $w 3 -minsize 5
1423    grid [TitleFrame $w.4 -bd 6 -relief groove -text "Modify occupanc${suffixy}"] \
1424            -row 4 -column 0 -columnspan 10 -sticky news
1425    set w2 [$w.4 getframe]
1426    grid [label $w2.1 -text "Occupancy: "] -row 1 -column 0
1427    grid [entry $w2.e -width 10] -column 1 -row 1
1428    $w2.e delete 0 end
1429    $w2.e insert end 1.0
1430    grid columnconfigure $w2 2 -weight 1
1431    grid [button $w2.do -text "Set Occupanc${suffixy}" \
1432            -command "XformAtomsOcc $phase [list $numberList] $w2" \
1433            ] -row 2 -column 0 -columnspan 10
1434
1435    grid rowconfigure $w 5 -minsize 5
1436    grid [TitleFrame $w.6 -bd 6 -relief groove \
1437            -text "Modify Displacement Parameter$suffix"] \
1438            -row 6 -column 0 -columnspan 10 -sticky news
1439    set w2 [$w.6 getframe]
1440    grid [entry $w2.e -width 10] -column 1 -row 1
1441    $w2.e delete 0 end
1442    $w2.e insert end 0.025
1443    grid columnconfigure $w2 2 -weight 1
1444    grid [button $w2.do -text "Set U" \
1445            -command "XformAtomsU $phase [list $numberList] $w2" \
1446            ] -row 2 -column 0 -columnspan 10
1447    grid [frame $w2.f] -row 3 -column 0 -columnspan 10
1448
[536]1449    if {[lindex $expmap(phasetype) [expr {$p - 1}]] != 4} {
1450        grid [label $w2.1 -text "Uiso or Uequiv: "] -row 1 -column 0
1451        grid [button $w2.f.iso -text "Set Isotropic" \
1452                -command "XformAtomsU $phase [list $numberList] iso" \
1453                ] -row 0 -column 0
1454        grid [button $w2.f.aniso -text "Set Anisotropic" \
1455                -command "XformAtomsU $phase [list $numberList] aniso" \
1456                ] -row 0 -column 1
1457    } else {
1458        grid [label $w2.1 -text "Uiso: "] -row 1 -column 0
1459    }
1460
[254]1461    grid rowconfigure $w 5 -minsize 5
[536]1462    if {[lindex $expmap(phasetype) [expr {$p - 1}]] != 4} {
1463        grid [TitleFrame $w.8 -bd 6 -relief groove \
1464                -text "Erase Atom$suffix"] \
1465                -row 8 -column 0 -columnspan 10 -sticky news
1466        set w2 [$w.8 getframe]
1467        grid [button $w2.do -text "Erase Atom${suffix}" \
1468                -command "EraseAtoms $phase [list $numberList] $w" \
1469                ] -row 2 -column 0 -columnspan 10
1470    }
[254]1471
1472    grid rowconfigure $w 9 -minsize 5
[321]1473    grid [frame $w.b] -row 10 -column 0 -columnspan 10 -sticky ew
1474    pack [button $w.b.3 -text Close -command "destroy $w"] -side left \
1475            -padx 5 -pady 5
1476    pack [button $w.b.help -text Help -bg yellow \
1477            -command "MakeWWWHelp expgui2.html xform"] -side right \
1478            -padx 5 -pady 5
[254]1479    bind $w <Return> "destroy $w"
1480
1481    # force the window to stay on top
1482    putontop $w
1483    focus $w.b.3
1484    tkwait window $w
1485    afterputontop
1486    # if there are selected atoms, reset their display
1487    if {[llength $expgui(selectedatomlist)] != 0} editRecord
1488}
1489
1490# transform the coordinates
1491proc XformAtomsCoord {phase numberList w1} {
[536]1492    global expgui expmap
1493    if {[lindex $expmap(phasetype) [expr {$phase - 1}]] == 4} {
1494        set cmd mmatominfo
1495    } else {
1496        set cmd atominfo
1497    }
[254]1498    # get the matrix
1499    foreach v {x y z} {
1500        foreach o {x y z} {
1501            set matrix(${v}${o}) [$w1.e${v}${o} get]
1502        }
1503        set matrix(${v}) [$w1.e${v} get]
1504    }
1505    foreach atom $numberList {
1506        foreach v {x y z} {
[536]1507            set $v [$cmd $phase $atom $v]
[254]1508        }
1509        foreach v {x y z} {
1510            set new$v $matrix(${v})
1511            foreach o {x y z} {
1512                set new$v [expr [set new$v] + $matrix(${v}${o})*[set $o]]
1513            }
[536]1514            $cmd $phase $atom $v set [set new$v]
[254]1515        }
1516        incr expgui(changed)
1517    }
[536]1518    UpdateAtomLine $numberList $phase
[254]1519}
1520
1521# set the occupancies to a single value
1522proc XformAtomsOcc {phase numberList w2} {
[536]1523    global expgui expmap
1524    if {[lindex $expmap(phasetype) [expr {$phase - 1}]] == 4} {
1525        set cmd mmatominfo
1526    } else {
1527        set cmd atominfo
1528    }
[254]1529    # get the value
1530    set val [$w2.e get]
1531    foreach atom $numberList {
[536]1532        $cmd $phase $atom frac set $val
[254]1533        incr expgui(changed)
1534    }
[536]1535    UpdateAtomLine $numberList $phase
[254]1536}
1537
1538# transform Uiso or Uij; if anisotropic set Uequiv to Uij
1539proc XformAtomsU {phase numberList w2} {
1540    global expgui
1541    if {$w2 == "iso"} {
1542        foreach atom $numberList {
1543            if {[atominfo $phase $atom temptype] != "I"} {
1544                atominfo $phase $atom temptype set I
[487]1545                incr expgui(changed)
[254]1546            }
1547        }
1548    } elseif {$w2 == "aniso"} {
1549        foreach atom $numberList {
1550            if {[atominfo $phase $atom temptype] == "I"} {
1551                atominfo $phase $atom temptype set A
[487]1552                incr expgui(changed)
[254]1553            }
1554        }
1555    } else {
1556        # get the value
1557        set val [$w2.e get]
1558        foreach atom $numberList {
[536]1559            global expmap
1560            if {[lindex $expmap(phasetype) [expr {$phase - 1}]] == 4} {
1561                mmatominfo $phase $atom Uiso set $val
1562            } elseif {[atominfo $phase $atom temptype] == "I"} {
[254]1563                atominfo $phase $atom Uiso set $val
1564            } else {
1565                atominfo $phase $atom U11 set $val
1566                atominfo $phase $atom U22 set $val
1567                atominfo $phase $atom U33 set $val
1568                atominfo $phase $atom U12 set 0.0
1569                atominfo $phase $atom U13 set 0.0
1570                atominfo $phase $atom U23 set 0.0
1571            }
1572            incr expgui(changed)
1573        }
1574    }
[536]1575    UpdateAtomLine $numberList $phase
[254]1576}
1577
1578# confirm and erase atoms
1579proc EraseAtoms {phase numberList w2} {
1580    global expgui
1581    if {[llength $numberList] <= 0} return
1582    # make a list of atoms
1583    foreach atom $numberList {
1584        append atomlist "\n\t$atom  [atominfo $phase $atom label]"
1585    }
1586    set msg "OK to remove the following [llength $numberList] atoms from phase $phase:$atomlist"
1587    set val [MyMessageBox -parent $w2 -type okcancel -icon warning \
1588            -default cancel -title "Confirm Erase" -message $msg]
1589    if {$val == "ok"} {
1590        foreach atom $numberList {
1591            EraseAtom $atom $phase
1592            incr expgui(changed)
1593        }
1594        mapexp
[536]1595        DisplayAllAtoms $phase
[254]1596        destroy $w2
1597    }
1598}
1599
[447]1600#----------- more Add Phase routines (import) -------------------------------
[268]1601proc ImportPhase {format np} {
1602    global expgui
1603    foreach item $expgui(extensions_$format) {
1604        lappend typelist [list $format $item]
1605    }
1606    lappend typelist [list "All files" *]
1607    set file [tk_getOpenFile -parent $np -filetypes $typelist]
1608    if {![file exists $file]} return
1609    # read in the file
1610    set input [$expgui(proc_$format) $file]
1611    catch {
1612        $np.bf.b1 config -text "Continue" -command "addphase $np; AddAtomsList"
1613        bind $np <Return> "addphase $np; AddAtomsList"
1614    }
1615    catch {
1616        $np.t1 delete 0 end
1617        $np.t1 insert end "from $file"
1618    }
1619    $np.t2 delete 0 end
1620    $np.t2 insert end [lindex $input 0]
1621    foreach i {.e1a .e1b .e1c .e2a .e2b .e2g} val [lindex $input 1] {
1622        $np.f$i delete 0 end
1623        $np.f$i insert end $val
1624    }
1625    set expgui(coordList) [lindex $input 2]
[284]1626    set msg [lindex $input 3]
1627    if {$msg != ""} {
[378]1628        catch {destroy $np.msg}
1629        grid [label $np.msg -text $msg -fg red -anchor center -bd 4 -relief raised] \
1630                -column 0 -columnspan 99 -row 20 -sticky ew
[284]1631    }
[268]1632}
1633
[379]1634proc ImportAtoms {format top phase} {
[268]1635    global expgui
1636    foreach item $expgui(extensions_$format) {
1637        lappend typelist [list $format $item]
1638    }
1639    lappend typelist [list "All files" *]
1640    set file [tk_getOpenFile -parent $top -filetypes $typelist]
1641    if {![file exists $file]} return
[536]1642    # disable during read
1643    catch {
1644        foreach b "$top.b1 $top.b2 $top.fr.b3" {
1645            $b config -state disabled
1646        }
1647    }
[268]1648    # read in the file
1649    set input [$expgui(proc_$format) $file]
1650    # add atoms to table
1651    foreach item [lindex $input 2] {
1652        set row [MakeAddAtomsRow $top]
1653        set np $top.canvas.fr
1654        foreach val $item w {n x y z t o u} {
1655            if {$val != ""} {
1656                $np.e${row}$w delete 0 end
1657                $np.e${row}$w insert end $val
1658            }
1659        }
1660    }
[379]1661    # sort the atoms by number, so that empty entries are at the bottom
1662    sortAddAtoms $phase $top number
[536]1663    # reenable
1664    catch {
1665        foreach b "$top.b1 $top.b2 $top.fr.b3" {
1666            $b config -state normal
1667        }
1668    }
[268]1669}
1670
1671proc AddAtomsList {} {
1672    global expgui expmap
[378]1673    # skip if we aborted out of addphase
1674    if {$expgui(oldphaselist) == -1} return
[268]1675    # find the new phase
1676    set phase {}
1677    foreach p $expmap(phaselist) {
1678        if {[lsearch $expgui(oldphaselist) $p] == -1} {
1679            set phase $p
1680            break
1681        }
1682    }
1683    if {$phase == ""} return
1684    MakeAddAtomsBox $phase $expgui(coordList)
1685}
1686
1687# get the input formats by sourcing files named import_*.tcl
1688proc GetImportFormats {} {
1689    global expgui tcl_platform
1690    # only needs to be done once
1691    if [catch {set expgui(importFormatList)}] {
1692        set filelist [glob -nocomplain [file join $expgui(scriptdir) import_*.tcl]]
1693        foreach file $filelist {
[641]1694            set description ""
[268]1695            source $file
[641]1696            if {$description != ""} {
1697                lappend expgui(importFormatList) $description
1698                if {$tcl_platform(platform) == "unix"} {
1699                    set extensions "[string tolower $extensions] [string toupper $extensions]"
1700                }
1701                set expgui(extensions_$description) $extensions
1702                set expgui(proc_$description) $procname
[268]1703            }
1704        }
1705    }
1706}
1707
1708proc MakeReplacePhaseBox {} {
1709    global expmap expgui tcl_platform
1710
1711    set expgui(coordList) {}
1712    # ignore the command if no phase is selected
1713    foreach p {1 2 3 4 5 6 7 8 9} {
1714        if {[lsearch $expmap(phaselist) $expgui(curPhase)] == -1} {
1715            return
1716        }
1717    }
1718
1719    set top .newphase
1720    catch {destroy $top}
1721    toplevel $top
[321]1722    bind $top <Key-F1> "MakeWWWHelp expgui2.html replacephase"
[268]1723
1724    grid [label $top.l1 -text "Replacing phase #$expgui(curPhase)" \
1725            -bg yellow -anchor center] -column 0 -columnspan 8 -row 0 -sticky ew
1726    grid [label $top.l3a -text "Current Space Group: "] \
1727            -column 0 -row 2 -columnspan 2 -sticky e
1728    grid [label $top.l3b -text [phaseinfo $expgui(curPhase) spacegroup]\
1729            -bd 4 -relief groove] \
1730            -column 2 -row 2  -sticky ew
1731    grid [label $top.l4 -text "New Space Group: "] \
1732            -column 0 -row 3 -columnspan 2 -sticky e
1733    grid [entry $top.t2 -width 12] -column 2 -row 3 -sticky w
1734    grid [radiobutton $top.r1 -text "Reenter current atoms"\
1735            -variable expgui(DeleteAllAtoms) -value 0] \
1736            -column 1 -row 4 -columnspan 8 -sticky w
1737    grid [radiobutton $top.r2 -text "Delete current atoms" \
1738            -variable expgui(DeleteAllAtoms) -value 1] \
1739            -column 1 -row 5 -columnspan 8 -sticky w
1740   
1741    grid [frame $top.f -bd 4 -relief groove] \
1742            -column 3 -row 2 -columnspan 3 -rowspan 4
1743    set col -1
1744    foreach i {a b c} {
1745        grid [label $top.f.l1$i -text " $i "] -column [incr col] -row 1
1746        grid [entry $top.f.e1$i -width 12] -column [incr col]  -row 1
1747        $top.f.e1$i delete 0 end
1748        $top.f.e1$i insert 0 [phaseinfo $expgui(curPhase) $i]
1749    }
1750    set col -1
1751    foreach i {a b g} var {alpha beta gamma} {
[413]1752        grid [label $top.f.l2$i -text $i] -column [incr col] -row 2
1753        set font [$top.f.l2$i cget -font]
1754        $top.f.l2$i config -font "Symbol [lrange $font 1 end]"
[268]1755        grid [entry $top.f.e2$i -width 12] -column [incr col]  -row 2
1756        $top.f.e2$i delete 0 end
1757        $top.f.e2$i insert 0 [phaseinfo $expgui(curPhase) $var]
1758    } 
1759
1760    grid [button $top.b1 -text Continue \
1761            -command "replacephase1 $top $expgui(curPhase)"] \
1762            -column 0 -row 6 -sticky w
1763    bind $top <Return> "replacephase1 $top $expgui(curPhase)"
1764    grid [button $top.b2 -text Cancel \
1765            -command "destroy $top"] -column 1 -row 6 -sticky w
[321]1766    grid [button $top.help -text Help -bg yellow \
1767            -command "MakeWWWHelp expgui2.html replacephase"] \
1768            -column 2 -row 6
[268]1769
1770    # get the input formats if not already defined
1771    GetImportFormats
1772    if {[llength $expgui(importFormatList)] > 0} {
1773        grid [frame $top.fr -bd 4 -relief groove] \
1774                -column 2 -row 6 -columnspan 8 -sticky e
1775        grid [button $top.fr.b3 -text "Import phase from: " \
1776                -command "ImportPhase \$expgui(importFormat) $top"] \
1777                -column 0 -row 0 -sticky e
[553]1778        set menu [eval tk_optionMenu $top.fr.b4 expgui(importFormat) \
1779                $expgui(importFormatList)]
1780        for {set i 0} {$i <= [$menu index end]} {incr i} {
1781            $menu entryconfig $i -command "ImportPhase \$expgui(importFormat) $np"
1782        }
[268]1783        grid $top.fr.b4 -column 1 -row 0 -sticky w
1784        grid rowconfig $top.fr 0 -pad 10
1785        grid columnconfig $top.fr 0 -pad 10
1786        grid columnconfig $top.fr 1 -pad 10
[284]1787#       grid columnconfig $top 4 -weight 1
1788        grid columnconfig $top 2 -weight 1
[268]1789    }
1790   
1791    wm title $top "Replace phase $expgui(curPhase)"
1792
[326]1793    # set grab, etc.
[268]1794    putontop $top
1795
1796    tkwait window $top
1797
[326]1798    # fix grab...
[268]1799    afterputontop
1800}
1801
1802proc replacephase1 {top phase} {
1803    # validate cell & space group & save to pass
1804    global expgui expmap
1805    set expgui(SetAddAtomsScroll) 0
1806    # validate the input
1807    set err {}
1808    set spg [$top.t2 get]
1809    if {[string trim $spg] == ""} {
1810        append err "  Space group cannot be blank\n"
1811    }
1812    set cell {}
1813    foreach i {a b c a b g} lbl {a b c alpha beta gamma} n {1 1 1 2 2 2} {
1814        set $lbl [$top.f.e${n}$i get]
1815        if {[string trim [set $lbl]] == ""} {
1816            append err "  $lbl cannot be blank\n"
1817        } elseif {[catch {expr [set $lbl]}]} {
1818            append err "  [set $lbl] is not valid for $lbl\n"
1819        }
1820        lappend cell [set $lbl]
1821    }
1822
1823    if {$err != ""} {
[383]1824        MyMessageBox -parent $top -title "Replace Phase Error" -icon warning \
1825                -message "The following error(s) were found in your input:\n$err" 
[268]1826        return
1827    }
1828
1829    # check the space group
1830    set fp [open spg.in w]
1831    puts $fp "N"
1832    puts $fp "N"
1833    puts $fp $spg
1834    puts $fp "Q"
1835    close $fp
1836    global tcl_platform
1837    catch {
1838        if {$tcl_platform(platform) == "windows"} {
1839            exec [file join $expgui(gsasexe) spcgroup.exe] < spg.in >& spg.out
1840        } else {
1841            exec [file join $expgui(gsasexe) spcgroup] < spg.in >& spg.out
1842        }
1843    }
1844    set fp [open spg.out r]
1845    set out [read $fp]
1846    close $fp
1847    # attempt to parse out the output (fix up if parse did not work)
1848    if {[regexp "space group symbol.*>(.*)Enter a new space group symbol" \
1849            $out a b ] != 1} {set b $out}
1850    if {[string first Error $b] != -1} {
1851        # got an error, show it
1852        ShowBigMessage \
1853                 $top.error \
1854                 "Error processing space group\nReview error message below" \
[447]1855                 $b OK "" 1
[268]1856        return
1857    } else {
1858        # show the result and confirm
1859        set opt [ShowBigMessage \
1860                $top.check \
1861                "Check the symmetry operators in the output below" \
1862                $b \
1863                {Continue Redo} ]
1864        if {$opt > 1} return
1865    }
1866    file delete spg.in spg.out
1867    # draw coordinates box
1868    eval destroy [winfo children $top]
1869    grid [label $top.l1 -relief groove -bd 4 -anchor center\
1870            -text "Atom list for phase #$phase"] \
1871            -column 0 -row 0 \
1872            -sticky we -columnspan 10
1873    grid [canvas $top.canvas \
1874            -scrollregion {0 0 5000 500} -width 0 -height 250 \
1875            -yscrollcommand "$top.scroll set"] \
1876            -column 0 -row 2 -columnspan 4 -sticky nsew
1877    grid columnconfigure $top 3 -weight 1
1878    grid rowconfigure $top 2 -weight 1
1879    grid rowconfigure $top 1 -pad 5
1880    scrollbar $top.scroll \
1881            -command "$top.canvas yview"
1882    frame $top.canvas.fr
1883    $top.canvas create window 0 0 -anchor nw -window $top.canvas.fr
1884
1885    set np $top.canvas.fr
1886    set row 0
1887    set col 0
[379]1888    grid [label $np.l_${row}0 -text "  #  "] -column $col -row $row
1889    foreach i {Atom\ntype Name x y z Occ Uiso} \
1890            var {type name x y z occ uiso} {
1891        grid [button $np.l_${row}$i -text $i -padx 0 -pady 0 \
1892                -command "sortAddAtoms $phase $top $var"] \
1893                -column [incr col] -row $row -sticky nsew
[268]1894    }
[379]1895    grid [label $np.l_${row}Use -text Use\nFlag] -column [incr col] -row $row
[268]1896
1897    # add the old atoms, if appropriate
1898    if {!$expgui(DeleteAllAtoms)} {
1899        # loop over all atoms
1900        foreach atom $expmap(atomlist_$phase) {
1901            set row [MakeAddAtomsRow $top]
1902            # add all atoms in the current phase to the list
1903            foreach w {n x y z t o} var {label x y z type frac} {
1904                $np.e${row}$w delete 0 end
1905                $np.e${row}$w insert end [atominfo $phase $atom $var]
1906            }
1907            $np.e${row}u delete 0 end
1908            if {[atominfo $phase $atom temptype] == "I"} {
1909                $np.e${row}u insert end [atominfo $phase $atom Uiso]
1910            } else {
1911                $np.e${row}u insert end [expr ( \
1912                        [atominfo $phase $atom U11] + \
1913                        [atominfo $phase $atom U22] + \
1914                        [atominfo $phase $atom U33]) / 3.]
1915            }
1916        }
1917    }
1918
1919    # add coordinates that have been read in, if any
1920    foreach item $expgui(coordList) {
1921        set row [MakeAddAtomsRow $top]
1922        foreach val $item w {n x y z t o u} {
1923            if {$val != ""} {
1924                $np.e${row}$w delete 0 end
1925                $np.e${row}$w insert end $val
1926            }
1927        }
1928    }
1929    # a blank spot in the table
1930    MakeAddAtomsRow $top
1931
1932    bind $top <Configure> "SetAddAtomsScroll $top"
1933    grid rowconfigure $top 3 -min 10
1934    grid [button $top.b1 -text "Continue"\
1935            -command "replacephase2 $phase $top [list $spg] [list $cell]"] \
1936            -column 0 -row 5 -sticky w
1937    bind $top <Return> "replacephase2 $phase $top [list $spg] [list $cell]"
1938    grid [button $top.b2 -text Cancel \
1939            -command "destroy $top"] -column 1 -row 5 -sticky w
1940    if {[llength $expgui(importFormatList)] > 0} {
1941        grid [frame $top.fr -bd 4 -relief groove] \
1942                -column 3 -row 5 -columnspan 2 -sticky e
1943        grid [button $top.fr.b3 -text "Import atoms from: " \
[379]1944                -command "ImportAtoms \$expgui(importFormat) $top $phase"] \
[268]1945                -column 0 -row 0 -sticky e
[553]1946        set menu [eval tk_optionMenu $top.fr.b4 expgui(importFormat) \
1947                $expgui(importFormatList)]
1948        for {set i 0} {$i <= [$menu index end]} {incr i} {
1949            $menu entryconfig $i -command "ImportAtoms \$expgui(importFormat) $top $phase"
1950        }
[268]1951        grid $top.fr.b4 -column 1 -row 0 -sticky w
1952        grid rowconfig $top.fr 0 -pad 10
1953        grid columnconfig $top.fr 0 -pad 10
1954        grid columnconfig $top.fr 1 -pad 10
1955    }
1956
1957    grid [button $top.b3 -text  "More atom boxes" \
1958            -command "MakeAddAtomsRow $top"] -column 3 \
1959            -columnspan 2 -row 4 -sticky e
1960   
1961    wm title $top "Replacing phase: Enter atoms"
1962    SetAddAtomsScroll $top
1963
[326]1964    # fix grab for old window
[268]1965    afterputontop
[326]1966    # set grab, etc.
[268]1967    putontop $top
1968}
1969
1970proc replacephase2 {phase top spg cell} {
1971    global expgui expmap env
1972    # validate coordinates
1973    set np $top.canvas.fr
[536]1974    # validate the atoms info
1975    set atomlist [ValidateAtomsBox $top $np]
[553]1976    if {$atomlist == ""} return
[268]1977
1978    pleasewait "updating phase"
1979    # replace spacegroup and cell
1980    phaseinfo $phase spacegroup set $spg
1981    foreach val $cell var {a b c alpha beta gamma} {
1982        phaseinfo $phase $var set $val
1983    }
[536]1984    incr expgui(changed) 
[268]1985    # delete all atoms
1986    foreach i $expmap(atomlist_$phase) {
1987        EraseAtom $i $phase
[536]1988        incr expgui(changed) 
[268]1989    }
1990    # write new atoms from table as input to exptool
1991    set fp [open exptool.in w]
1992    puts $fp "A"
1993    puts $fp $phase
1994    # number of atoms
1995    puts $fp [llength $atomlist]
1996    foreach atomline $atomlist {
1997        puts $fp $atomline
[536]1998        incr expgui(changed) 
[268]1999    }
2000    close $fp
2001    # needed in UNIX
2002    set env(ATOMDATA) [file join $expgui(gsasdir) data atmdata.dat]
[394]2003    set env(gsas) [file nativename $expgui(gsasdir)]
[268]2004    # needed in Windows
2005    set env(GSAS) [file nativename $expgui(gsasdir)]
2006
2007    global tcl_platform
2008    # Save the current exp file
2009    savearchiveexp
2010    # disable the file changed monitor
2011    set expgui(expModifiedLast) 0
2012    set expnam [file root [file tail $expgui(expfile)]]
2013    catch {
2014        if {$tcl_platform(platform) == "windows"} {
2015            exec [file join $expgui(gsasexe) exptool.exe] $expnam \
2016                    < exptool.in >& exptool.out
2017        } else {
2018            exec [file join $expgui(gsasexe) exptool] $expnam \
2019                    < exptool.in >& exptool.out
2020        }
2021    } errmsg
2022    # load the revised exp file
2023    loadexp $expgui(expfile)
2024    set fp [open exptool.out r]
2025    set out [read $fp]
2026    close $fp
[447]2027    set err 0
[536]2028    if {[llength $atomlist] != [llength $expmap(atomlist_$phase))]} {
[447]2029        set err 1
2030    }
[268]2031    if {$errmsg != ""} {
2032        append errmsg "\n" $out
[447]2033        set err 1
[268]2034    } else {
2035        set errmsg $out
2036    }
2037    donewait 
[447]2038    if {$expgui(showexptool) || $err} {
2039        set msg "Please review the result from adding the atom(s)" 
2040        if {$err} {append msg "\nIt appears an error occurred!"}
2041        ShowBigMessage $top $msg $errmsg OK "" $err
[321]2042    }
[268]2043    file delete exptool.in exptool.out
[668]2044    # set the powpref warning (2 = required)
2045    set expgui(needpowpref) 2
2046    set msg "A phase was replaced"
2047    if {[string first $msg $expgui(needpowpref_why)] == -1} {
2048        append expgui(needpowpref_why) "\t$msg\n"
2049    }
[268]2050    destroy $top
2051}
2052
[379]2053proc sortAddAtoms {phase top sortvar} {
2054    global expgui
2055    set np $top.canvas.fr
2056    set validlist {}
2057    set invalidlist {}
2058    set row 0
2059    while {![catch {grid info $np.e[incr row]t}]} {
2060        set valid 1
2061        set line $row
2062        if !{$expgui(UseAtom$row)} {set valid 0}
2063        lappend line $expgui(UseAtom$row)
2064        if {[set type [string trim [$np.e${row}t get]]] == ""} {set valid 0}
2065        lappend line [string trim [$np.e${row}t get]]
2066        lappend line [string trim [$np.e${row}n get]]
2067        foreach i {x y z o u} {
2068            set tmp [string trim [$np.e${row}$i get]]
2069            lappend line $tmp
2070            if {$tmp == "" || [catch {expr $tmp}]} {set valid 0}
2071        }
2072        if {$valid} {
2073            lappend validlist $line
2074        } else {
2075            lappend invalidlist $line
2076        }
2077    }
2078    switch $sortvar {
2079        type {set sortlist [lsort -index 2 -dictionary $validlist]}
2080        name {set sortlist [lsort -index 3 -dictionary $validlist]}
2081        x {set sortlist [lsort -index 4 -real $validlist]}
2082        y {set sortlist [lsort -index 5 -real $validlist]}
2083        z {set sortlist [lsort -index 6 -real $validlist]}
2084        occ {set sortlist [lsort -index 7 -real $validlist]}
2085        uiso  {set sortlist [lsort -index 8 -real $validlist]}
2086        default {set sortlist $validlist}
2087    }
2088
2089    if {[llength $invalidlist] > 0} {append sortlist " $invalidlist"}
2090    set row 0
2091    foreach line $sortlist {
2092        incr row
2093        set expgui(UseAtom$row) [lindex $line 1]
2094        foreach item [lrange $line 2 end] \
2095                var {t n x y z o u} {
2096            $np.e${row}$var delete 0 end
2097            $np.e${row}$var insert end $item
2098        }
2099    }
2100}
[694]2101
2102proc EditInstFile {"filename {}"} {
2103    global expgui
2104    # on the first call, load the commands
2105    if {[catch {
2106        if {[info procs instMakeWindow] == ""} {
2107            source [file join $expgui(scriptdir) instedit.tcl]
2108        }
2109    } errmsg]} {
2110        MyMessageBox -parent . -title "Load error" \
2111                -message "Unexpected error while sourcing file instedit.tcl: $errmsg" \
2112                -icon error
2113    }
2114    instMakeWindow $filename
2115}
2116
[394]2117# default
[458]2118set newhist(insttype) {}
[447]2119set newhist(dummy) 0
[668]2120set newhist(instfiletext) {}
Note: See TracBrowser for help on using the repository browser.