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
Line 
1# $Id: addcmds.tcl 694 2009-12-04 23:10:27Z 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.f -bd 4 -relief groove] -column 3 -row 2 -columnspan 8
37    set col -1
38    foreach i {a b c} {
39        grid [label $np.f.l1$i -text " $i "] -column [incr col] -row 1
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} {
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]"
47        grid [entry $np.f.e2$i -width 12] -column [incr col]  -row 2
48        $np.f.e2$i insert 0 90.
49    }   
50   
51    grid [frame $np.bf] -row 3 -column 0 -columnspan 10 -sticky ew
52    grid [button $np.bf.b1 -text Add \
53            -command "addphase $np"] -column 2 -row 3
54    bind $np <Return> "addphase $np"
55    grid [button $np.bf.b2 -text Cancel \
56            -command "destroy $np"] -column 3 -row 3
57    grid columnconfig $np.bf 4 -weight 1
58    grid [button $np.bf.help -text Help -bg yellow \
59            -command "MakeWWWHelp expgui2.html addphase"] \
60            -column 4 -row 3
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
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        }
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    }
79    wm title $np "add new phase"
80
81    # set grab, etc.
82    putontop $np
83   
84    tkwait window $np
85   
86    # fix grab...
87    afterputontop
88}
89
90proc addphase {np} {
91    global expgui expmap
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 != ""} {
121        MyMessageBox -parent . -title "Add Phase Error" \
122                -message "The following error(s) were found in your input:\n$err" \
123                -icon error
124        set expgui(oldphaselist) -1
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" \
154                 $b OK "" 1
155        set expgui(oldphaselist) -1
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} ]
164        if {$opt > 1} {
165            set expgui(oldphaselist) -1
166            return
167        }
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)]]
185    # save the previous phase list
186    set expgui(oldphaselist) $expmap(phaselist)
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        }
195    } errmsg
196    # load the revised exp file
197    set oldphaselist $expmap(phaselist)
198    loadexp $expgui(expfile)
199    set fp [open exptool.out r]
200    set out [read $fp]
201    close $fp
202    destroy $np
203    set err 0
204    if {[llength $oldphaselist] == [llength $expmap(phaselist)]} {set err 1}
205    if {$errmsg != ""} {
206        set err 1
207        append errmsg "\n" $out
208    } else {
209        set errmsg $out
210    }
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
215    }
216    file delete exptool.in exptool.out
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    }
223    # now select the new phase
224    SelectOnePhase [lindex $expmap(phaselist) end]   
225}
226
227#----------- Add Histogram routines --------------------------------------
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
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
253    bind $np <Key-F1> "MakeWWWHelp expgui3.html AddHist"
254
255    grid [label $np.l0 -text "Adding a new histogram"] \
256            -column 0 -row 0 -sticky ew -columnspan 7
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
261    grid [label $np.t1 -textvariable newhist(rawfile) -bd 2 -relief ridge] \
262            -column 1 -row 2 -columnspan 3 -sticky ew
263    grid [button $np.b1 -text "Select File" \
264            -command "getrawfile $np" \
265            ] -column 4 -row 2
266
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
269
270    grid [label $np.l2 -text "Instrument\nParameter file:"] -column 0 -row 5
271    grid [label $np.t2 -textvariable newhist(instfile) -bd 2 -relief ridge] \
272            -column 1 -row 5 -columnspan 3 -sticky ew
273    grid [button $np.b2 -text "Select File" \
274            -command "getinstfile $np" \
275            ] -column 4 -row 5
276    grid [button $np.edit -text "Edit file" \
277            -command {EditInstFile $newhist(instfile)}] \
278            -column 5 -row 5
279
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
282    grid [label $np.t2a -textvariable newhist(instfiletext) \
283            -justify center -anchor center -fg blue] \
284            -column 0 -row 8 -columnspan 99 -sticky ew
285
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 
289    grid [entry $np.e3 -width 12 -textvariable newhist(2tLimit) \
290            ] -column 1 -row 18 -rowspan 3
291    grid [radiobutton $np.cb3 -text "D-min" -variable newhist(LimitMode) \
292            -value 0] -column 2 -row 18 -sticky w
293    grid [radiobutton $np.cb4 -textvariable newhist(limitLbl)  \
294            -variable newhist(LimitMode) -anchor w -justify l \
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
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] \
305            -columnspan 20 -column 0 -row 17 -sticky nsew -ipady 2
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
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
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
318    grid columnconfigure $np 3 -weight 1
319
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
334    wm title $np "add new histogram"
335
336    set newhist(banknum) {}
337    set newhist(setnum) {}
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
345    PostDummyOpts $np
346    # set grab, etc.
347    putontop $np
348
349    tkwait window $np
350
351    # fix grab...
352    afterputontop
353}
354
355# convert a file to Win-95 direct access
356proc WinCvt {file win} {
357    global expgui
358    if ![file exists $file] {
359        MyMessageBox -parent $win -title "Convert Error" \
360                -message "File $file does not exist" -icon error
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] {
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
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} {
381            # this is an old-style UNIX file. Hope there are no control characters
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] {
403        MyMessageBox -parent $win -title Notify \
404                -message "Error in conversion:\n$errmsg" -icon warning
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} {
431    global expgui newhist
432    if {$inp == ""} return
433    if [catch {set in [open $inp r]}] {
434        MyMessageBox -parent $np -title "Open error" \
435                -message "Unable to open file $inp" -icon error
436        return 
437    }
438    set newhist(banklist) {}
439    foreach child [winfo children $np.bank] {destroy $child}
440    # is this a properly formatted file?
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
452                close $in
453                WinCvt $inp $np
454                set i 0
455                set in [open $inp r]
456                fconfigure $in -translation lf
457                set line {}
458            } else {
459                return
460            }
461        }
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
467            set tmin 0
468            set tmax 0
469            catch {
470                scan $line "BANK%d%d%d%s%f%f" num nchan nrec rest start step
471                set tmin [expr $start/100.]
472                set tmax [expr ($start + $step*($nchan-1))/100.]
473            }
474            set newhist(tmin$num) $tmin
475            set newhist(tmax$num) $tmax
476        }
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        }
483    }
484    # were banks found?
485    if {$newhist(banklist) == ""} {
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
489        return
490    }
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    }
497    set row 0
498    set col -1
499    foreach i $newhist(banklist) {
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
507        # only 1 choice, so set it
508        if {[llength $newhist(banklist)] == 1} {
509            set newhist(banknum) $i
510            SetTmax
511        } else {
512            set newhist(2tLimit) {}
513            set newhist(LimitMode) {}
514        }
515    }
516}
517
518proc SetTmax {} {
519    global newhist
520    set num $newhist(banknum)
521    if {$newhist(insttype) == "TOF"} {
522        set newhist(2tLimit) [expr {$newhist(tmin$num) / 10.}]
523        if {[llength $newhist(banklist)] == $newhist(instbanks)} {
524            set newhist(setnum) $newhist(banknum)
525        }
526    } else {
527        set newhist(2tLimit) $newhist(tmax$num)
528    }
529    set newhist(LimitMode) 1
530
531}
532
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    }
551    set newhist(setnum) {}
552    validateinstfile $np $inp
553}
554
555proc validateinstfile {np inp} {
556    global expgui newhist
557    if {$inp == ""} return
558    if [catch {set in [open $inp r]}] {
559        MyMessageBox -parent $np -title "Open error" \
560                -message "Unable to open file $inp" -icon error
561        return 
562    }
563    set newhist(instbanks) {}
564    foreach child [winfo children $np.set] {destroy $child}
565    # is this a properly formatted file?
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
575                close $in
576                WinCvt $inp $np
577                set in [open $inp r]
578                fconfigure $in -translation lf
579                set line {}
580            } else {
581                return
582            }
583        }
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]]
588        }
589        # scan for the INS   HTYPE line
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
595            } elseif {[string index [lindex $line 2] 1] == "X"} {
596                set newhist(insttype) "CW X"
597            } else {
598                set newhist(insttype) "CW N"
599            }
600        }
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        }
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        }
614    }
615    # were banks found?
616    if {$newhist(instbanks) == ""} {
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
620        return
621    }
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    }
628    set col -1
629    set row 0
630    for {set i 1} {$i <= $newhist(instbanks)} {incr i} {
631        if {$col > 8} {
632            set col -1
633            incr row
634        }
635        grid [radiobutton $np.set.$i -text $i \
636                -command "PostDummyOpts $np; ValidateDummyHist $np" \
637                -variable newhist(setnum) -value $i] \
638                -column [incr col] -row $row -sticky w
639        if {$newhist(instbanks) == 1} {set newhist(setnum) $i}
640    }
641    if {$newhist(dummy)} {PostDummyOpts $np; ValidateDummyHist $np}
642    LabelInstParm
643}
644
645proc addhist {np} {
646    global expgui newhist tcl_platform expmap
647    if {$newhist(dummy)} {
648        AddDummyHist $np
649        return
650    }
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"
673    } elseif {$newhist(2tLimit) <= 0} {
674        append err "  The 2Theta/d-space limit is not valid\n"
675    }
676    if {[string trim $newhist(LimitMode)] == ""} {
677        append err "  Please choose between either a 2Theta, Q or d-space limit\n"
678    }
679
680    if {$err != ""} {
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"
685        return
686    }
687
688    # ok do it!
689    set fp [open exptool.in w]
690    puts $fp "H"
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    }
698    puts $fp $newhist(banknum)
699    puts $fp $newhist(setnum)
700    if {$newhist(LimitMode) == 1} {
701        puts $fp "T"
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"
708    } else {
709        puts $fp "D"
710        puts $fp "$newhist(2tLimit)"
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        }
730    } errmsg
731    # load the revised exp file
732    set oldpowderlist $expmap(powderlist)
733    loadexp $expgui(expfile)
734    set fp [open exptool.out r]
735    set out [read $fp]
736    close $fp
737    destroy $np
738    set err 0
739    if {[llength $oldpowderlist] == [llength $expmap(powderlist)]} {set err 1}
740    if {$errmsg != ""} {
741        append errmsg "\n" $out
742        set err 1
743    } else {
744        set errmsg $out
745    }
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
750    }
751    file delete exptool.in exptool.out
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    }
767}
768
769proc RunRawplot {parent} {
770    global newhist tcl_platform
771    set f1 $newhist(rawfile)
772    set f2 $newhist(instfile)
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    }
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    }
816    # start RAWPLOT
817    runGSASprog rawplot 1
818    if {[winfo exists $parent.msg]} {raise $parent.msg}
819    update
820}
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        }
831        $np.d1.m1 config -text {}
832        $np.d1.m2 config -text {}
833        $np.b1 config -state disabled
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
838        if {$newhist(insttype) == "TOF"} {
839            $np.dl1 config -text "Data range:\n(TOF)"
840            $np.d1.lu config -text millisec
841            grid $np.dl2 -column 0 -row 19
842            catch {
843                set s $newhist(setnum)
844                foreach {x tmin tmax x} $newhist(inst${s}ITYP) {}
845                $np.d1.m1 config -text $tmin
846                $np.d1.m2 config -text $tmax
847            }
848        } elseif {[lindex $newhist(insttype) 0] == "CW"} {
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.
854        } elseif {$newhist(insttype) == "ED"} {
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.
859            grid $np.dl2 -column 0 -row 19
860        } else {
861            $np.dl1 config -text "No file\nselected"
862            $np.d1.lu config -text {}
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
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
882     }
883}
884
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 {
918            set s $newhist(setnum)
919            foreach {x tmin tmax x} $newhist(inst${s}ITYP) {}
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            }
928            set s $newhist(setnum)
929            set dmin [expr {1000. * $newhist(tmin) / \
930                    [lindex $newhist(inst${s}ICONS) 0]}]
931            set dmax [expr {1000. * $newhist(tmax) / \
932                    [lindex $newhist(inst${s}ICONS) 0]}]
933        }
934    } elseif {[lindex $newhist(insttype) 0] == "CW"} {
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 {
944            set s $newhist(setnum)
945            set dmin [expr {[lindex $newhist(inst${s}ICONS) 0]\
946                    * 0.5 / sin(acos(0.)*$newhist(tmax)/180.)}]
947            set dmax [expr {[lindex $newhist(inst${s}ICONS) 0]\
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 {
960            set s $newhist(setnum)
961            set ang [lindex $newhist(inst${s}ICONS) 0]
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
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    }
1069}
1070
1071
1072
1073#----------- Add Atoms routines ----------------------------------------
1074proc MakeAddAtomsBox {phase "atomlist {}"} {
1075    global expmap expgui
1076
1077    # is there room for more atoms? Well, we will check this someday
1078    if {$phase == ""} return
1079    if {[llength $phase] != 1} return
1080
1081    set top .newatoms
1082    catch {destroy $top}
1083    toplevel $top
1084    bind $top <Key-F1> "MakeWWWHelp expgui2.html addatoms"
1085
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
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
1112    }
1113    grid [label $np.l_${row}Use -text Use\nFlag] -column [incr col] -row $row
1114
1115    set expgui(SetAddAtomsScroll) 0
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    }
1131    bind $top <Configure> "SetAddAtomsScroll $top"
1132    grid rowconfigure $top 3 -min 10
1133    grid [button $top.b1 -text "Add Atoms"\
1134            -command "addatom $phase $top"] -column 0 -row 5 -sticky w
1135    bind $top <Return> "addatom $phase $top"
1136    grid [button $top.b2 -text Cancel \
1137            -command "destroy $top"] -column 1 -row 5 -sticky w
1138    grid [button $top.help -text Help -bg yellow \
1139            -command "MakeWWWHelp expgui2.html addatoms"] \
1140            -column 0 -columnspan 2 -row 4
1141
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: " \
1148                -command "ImportAtoms \$expgui(importFormat) $top $phase"] \
1149                -column 0 -row 0 -sticky e
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        }
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" \
1162            -command "MakeAddAtomsRow $top"] -column 3 \
1163            -columnspan 2 -row 4 -sticky e
1164   
1165    wm title $top "add new atom"
1166
1167    # set grab, etc.
1168    putontop $top
1169
1170    tkwait window $top
1171
1172    # fix grab...
1173    afterputontop
1174}
1175
1176proc MakeAddAtomsRow {top} {
1177    set np $top.canvas.fr
1178    set col -1
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
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} {
1186        grid [entry $np.e${row}$i -width 9] -column [incr col] -row $row
1187    }
1188    grid [checkbutton $np.e${row}use -variable expgui(UseAtom$row)] \
1189            -column [incr col] -row $row
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
1196    # default label
1197    $np.e${row}n delete 0 end
1198    $np.e${row}n insert end (default)
1199    # use by default
1200    $np.e${row}use select
1201
1202    SetAddAtomsScroll $top
1203    return $row
1204}
1205
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
1222}
1223
1224# Validate the atoms in the atoms add/phase replace box
1225# returns a null string on error or a list of atoms
1226proc ValidateAtomsBox {top np} {
1227    global expgui
1228    set row 0
1229    # loop over the defined rows
1230    set err {}
1231    set atomlist {}
1232    set validatmtypes {
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
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    }
1257    # loop over the defined rows
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]]
1264        }
1265        if {$line == ""} continue
1266
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        }
1271        if {[lsearch $validatmtypes [string toupper $type]] == -1} {
1272            append err "  line $row: Atom type $type is invalid for GSAS\n"
1273        }
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"
1285    }
1286    if {$err != ""} {
1287        MyMessageBox -icon warning -message "Note Errors:\n$err" -parent $top
1288        return {}
1289    }
1290    if {[llength $atomlist] == 0} {
1291        MyMessageBox -icon warning -message "No atoms to load!" -parent $top
1292        return {}
1293    }
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]
1302    if {$atomlist == ""} return
1303
1304    # ok add the atoms!
1305    set fp [open exptool.in w]
1306    puts $fp "A"
1307    puts $fp $phase
1308    # number of atoms
1309    puts $fp [llength $atomlist]
1310    foreach atomline $atomlist {
1311        puts $fp $atomline
1312    }
1313    close $fp
1314    # needed in UNIX
1315    set env(ATOMDATA) [file join $expgui(gsasdir) data atmdata.dat]
1316    set env(gsas) [file nativename $expgui(gsasdir)]
1317    # needed in Windows
1318    set env(GSAS) [file nativename $expgui(gsasdir)]
1319
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        }
1334    } errmsg
1335    # load the revised exp file
1336    set oldatomlist $expmap(atomlist_$phase)
1337    loadexp $expgui(expfile)
1338    set fp [open exptool.out r]
1339    set out [read $fp]
1340    close $fp
1341    destroy $top
1342    set err 0
1343    if {[llength $oldatomlist] == [llength $expmap(atomlist_$phase))]} {
1344        set err 1
1345    }
1346    if {$errmsg != ""} {
1347        append errmsg "\n" $out
1348        set err 1
1349    } else {
1350        set errmsg $out
1351    }
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
1356    }
1357    file delete exptool.in exptool.out
1358}
1359
1360#---------------------------------------------------------------------------
1361# commands to modify a group of selected atoms
1362#---------------------------------------------------------------------------
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"
1386    bind $w <Key-F1> "MakeWWWHelp expgui2.html xform"
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
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
1461    grid rowconfigure $w 5 -minsize 5
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    }
1471
1472    grid rowconfigure $w 9 -minsize 5
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
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} {
1492    global expgui expmap
1493    if {[lindex $expmap(phasetype) [expr {$phase - 1}]] == 4} {
1494        set cmd mmatominfo
1495    } else {
1496        set cmd atominfo
1497    }
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} {
1507            set $v [$cmd $phase $atom $v]
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            }
1514            $cmd $phase $atom $v set [set new$v]
1515        }
1516        incr expgui(changed)
1517    }
1518    UpdateAtomLine $numberList $phase
1519}
1520
1521# set the occupancies to a single value
1522proc XformAtomsOcc {phase numberList w2} {
1523    global expgui expmap
1524    if {[lindex $expmap(phasetype) [expr {$phase - 1}]] == 4} {
1525        set cmd mmatominfo
1526    } else {
1527        set cmd atominfo
1528    }
1529    # get the value
1530    set val [$w2.e get]
1531    foreach atom $numberList {
1532        $cmd $phase $atom frac set $val
1533        incr expgui(changed)
1534    }
1535    UpdateAtomLine $numberList $phase
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
1545                incr expgui(changed)
1546            }
1547        }
1548    } elseif {$w2 == "aniso"} {
1549        foreach atom $numberList {
1550            if {[atominfo $phase $atom temptype] == "I"} {
1551                atominfo $phase $atom temptype set A
1552                incr expgui(changed)
1553            }
1554        }
1555    } else {
1556        # get the value
1557        set val [$w2.e get]
1558        foreach atom $numberList {
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"} {
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    }
1575    UpdateAtomLine $numberList $phase
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
1595        DisplayAllAtoms $phase
1596        destroy $w2
1597    }
1598}
1599
1600#----------- more Add Phase routines (import) -------------------------------
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]
1626    set msg [lindex $input 3]
1627    if {$msg != ""} {
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
1631    }
1632}
1633
1634proc ImportAtoms {format top phase} {
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
1642    # disable during read
1643    catch {
1644        foreach b "$top.b1 $top.b2 $top.fr.b3" {
1645            $b config -state disabled
1646        }
1647    }
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    }
1661    # sort the atoms by number, so that empty entries are at the bottom
1662    sortAddAtoms $phase $top number
1663    # reenable
1664    catch {
1665        foreach b "$top.b1 $top.b2 $top.fr.b3" {
1666            $b config -state normal
1667        }
1668    }
1669}
1670
1671proc AddAtomsList {} {
1672    global expgui expmap
1673    # skip if we aborted out of addphase
1674    if {$expgui(oldphaselist) == -1} return
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 {
1694            set description ""
1695            source $file
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
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
1722    bind $top <Key-F1> "MakeWWWHelp expgui2.html replacephase"
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} {
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]"
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
1766    grid [button $top.help -text Help -bg yellow \
1767            -command "MakeWWWHelp expgui2.html replacephase"] \
1768            -column 2 -row 6
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
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        }
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
1787#       grid columnconfig $top 4 -weight 1
1788        grid columnconfig $top 2 -weight 1
1789    }
1790   
1791    wm title $top "Replace phase $expgui(curPhase)"
1792
1793    # set grab, etc.
1794    putontop $top
1795
1796    tkwait window $top
1797
1798    # fix grab...
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 != ""} {
1824        MyMessageBox -parent $top -title "Replace Phase Error" -icon warning \
1825                -message "The following error(s) were found in your input:\n$err" 
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" \
1855                 $b OK "" 1
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
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
1894    }
1895    grid [label $np.l_${row}Use -text Use\nFlag] -column [incr col] -row $row
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: " \
1944                -command "ImportAtoms \$expgui(importFormat) $top $phase"] \
1945                -column 0 -row 0 -sticky e
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        }
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
1964    # fix grab for old window
1965    afterputontop
1966    # set grab, etc.
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
1974    # validate the atoms info
1975    set atomlist [ValidateAtomsBox $top $np]
1976    if {$atomlist == ""} return
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    }
1984    incr expgui(changed) 
1985    # delete all atoms
1986    foreach i $expmap(atomlist_$phase) {
1987        EraseAtom $i $phase
1988        incr expgui(changed) 
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
1998        incr expgui(changed) 
1999    }
2000    close $fp
2001    # needed in UNIX
2002    set env(ATOMDATA) [file join $expgui(gsasdir) data atmdata.dat]
2003    set env(gsas) [file nativename $expgui(gsasdir)]
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
2027    set err 0
2028    if {[llength $atomlist] != [llength $expmap(atomlist_$phase))]} {
2029        set err 1
2030    }
2031    if {$errmsg != ""} {
2032        append errmsg "\n" $out
2033        set err 1
2034    } else {
2035        set errmsg $out
2036    }
2037    donewait 
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
2042    }
2043    file delete exptool.in exptool.out
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    }
2050    destroy $top
2051}
2052
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}
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
2117# default
2118set newhist(insttype) {}
2119set newhist(dummy) 0
2120set newhist(instfiletext) {}
Note: See TracBrowser for help on using the repository browser.