source: trunk/addcmds.tcl @ 321

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

# on 2000/10/12 21:35:45, toby did:
Add www help support
implement optional EXPTOOL output

  • Property rcs:author set to toby
  • Property rcs:date set to 2000/10/12 21:35:45
  • Property rcs:lines set to +57 -24
  • Property rcs:rev set to 1.13
  • Property rcs:state set to Exp
  • Property svn:keywords set to Author Date Revision Id
File size: 45.6 KB
RevLine 
[92]1# $Id: addcmds.tcl 321 2009-12-04 23:04:06Z toby $
2
3proc MakeAddPhaseBox {} {
[268]4    global expmap expgui tcl_platform
[92]5
[268]6    set expgui(coordList) {}
[92]7    set nextphase ""
8    foreach p {1 2 3 4 5 6 7 8 9} {
9        if {[lsearch $expmap(phaselist) $p] == -1} {
10            set nextphase $p
11            break
12        }
13    }
14
15    # no more room
16    if {$nextphase == ""} {
17        tk_dialog .phaseerr "Add Phase Error" \
18                "There are already 9 phases. You cannot add more." \
19                error 0 "OK" 
20        return
21    }
22
23    set np .newphase
24    catch {destroy $np}
25    toplevel $np
[321]26    bind $np <Key-F1> "MakeWWWHelp expgui2.html addphase"
[92]27
28    grid [label $np.l1 -text "Adding phase #$nextphase"] \
29            -column 0 -row 0 -sticky w
30    grid [label $np.l2 -text "Phase title:"] -column 0 -row 1 
31    grid [entry $np.t1 -width 68] -column 1 -row 1 -columnspan 8
32    grid [label $np.l3 -text "Space Group:"] -column 0 -row 2 
33    grid [entry $np.t2 -width 12] -column 1 -row 2 
34    grid [frame $np.f -bd 4 -relief groove] -column 3 -row 2 -columnspan 8
35    set col -1
36    foreach i {a b c} {
[268]37        grid [label $np.f.l1$i -text " $i "] -column [incr col] -row 1
[92]38        grid [entry $np.f.e1$i -width 12] -column [incr col]  -row 1
39    }
40    set col -1
41    foreach i {a b g} {
42        grid [label $np.f.l2$i -text $i -font symbol] -column [incr col] -row 2
43        grid [entry $np.f.e2$i -width 12] -column [incr col]  -row 2
44        $np.f.e2$i insert 0 90.
45    }   
46   
[268]47    grid [frame $np.bf] -row 3 -column 0 -columnspan 10 -sticky ew
48    grid [button $np.bf.b1 -text Add \
[92]49            -command "addphase $np"] -column 2 -row 3
50    bind $np <Return> "addphase $np"
[268]51    grid [button $np.bf.b2 -text Cancel \
[92]52            -command "destroy $np"] -column 3 -row 3
[268]53    grid columnconfig $np.bf 4 -weight 1
[321]54    grid [button $np.bf.help -text Help -bg yellow \
55            -command "MakeWWWHelp expgui2.html addphase"] \
56            -column 4 -row 3
[268]57
58    # get the input formats if not already defined
59    GetImportFormats
60    if {[llength $expgui(importFormatList)] > 0} {
61        grid [frame $np.bf.fr -bd 4 -relief groove] -column 5 -row 3
62        grid [button $np.bf.fr.b3 -text "Import phase from: " \
63                -command "ImportPhase \$expgui(importFormat) $np"] \
64                -column 0 -row 0 -sticky e
65        eval tk_optionMenu $np.bf.fr.b4 expgui(importFormat) \
66                $expgui(importFormatList)
67        grid $np.bf.fr.b4 -column 1 -row 0 -sticky w
68        grid rowconfig $np.bf.fr 0 -pad 10
69        grid columnconfig $np.bf.fr 0 -pad 10
70        grid columnconfig $np.bf.fr 1 -pad 10
71    }
[92]72    wm title $np "add new phase"
73
74    # grab focus, etc.
75    putontop $np
[268]76   
[92]77    tkwait window $np
[268]78   
[92]79    # fix focus...
80    afterputontop
81}
82
83proc addphase {np} {
[237]84    global expgui expmap
[92]85    # validate the input
86    set err {}
87    set title [$np.t1 get]
88    if {[string trim $title] == ""} {
89        append err "  Title cannot be blank\n"
90    }
91    set spg [$np.t2 get]
92    if {[string trim $spg] == ""} {
93        append err "  Space group cannot be blank\n"
94    }
95    foreach i {a b c} {
96        set cell($i) [$np.f.e1$i get]
97        if {[string trim $cell($i)] == ""} {
98            append err "  $i cannot be blank\n"
99        } elseif {[catch {expr $cell($i)}]} {
100            append err "  $i is not valid\n"
101        }
102    }
103
104    foreach i {a b g} lbl {alpha beta gamma} {
105        set cell($lbl) [$np.f.e2$i get]
106        if {[string trim $cell($lbl)] == ""} {
107            append err "  $lbl cannot be blank\n"
108        } elseif {[catch {expr $cell($lbl)}]} {
109            append err "  $lbl is not valid\n"
110        }
111    }
112
113    if {$err != ""} {
114        tk_dialog .phaseerr "Add Phase Error" \
115                "The following error(s) were found in your input:\n$err" \
116                error 0 "OK" 
117        return
118    }
119
120    # check the space group
121    set fp [open spg.in w]
122    puts $fp "N"
123    puts $fp "N"
124    puts $fp $spg
125    puts $fp "Q"
126    close $fp
127    global tcl_platform
128    catch {
129        if {$tcl_platform(platform) == "windows"} {
130            exec [file join $expgui(gsasexe) spcgroup.exe] < spg.in >& spg.out
131        } else {
132            exec [file join $expgui(gsasexe) spcgroup] < spg.in >& spg.out
133        }
134    }
135    set fp [open spg.out r]
136    set out [read $fp]
137    close $fp
138    # attempt to parse out the output (fix up if parse did not work)
139    if {[regexp "space group symbol.*>(.*)Enter a new space group symbol" \
140            $out a b ] != 1} {set b $out}
141    if {[string first Error $b] != -1} {
142        # got an error, show it
143        ShowBigMessage \
144                 $np.error \
145                 "Error processing space group\nReview error message below" \
146                 $b
147        return
148    } else {
149        # show the result and confirm
150        set opt [ShowBigMessage \
151                $np.check \
152                "Check the symmetry operators in the output below" \
153                $b \
154                {Continue Redo} ]
155        if {$opt > 1} return
156    }
157    file delete spg.in spg.out
158   
159    # ok do it!
160    set fp [open exptool.in w]
161    puts $fp "P"
162    puts $fp $title
163    puts $fp $spg
164    puts $fp "$cell(a) $cell(b) $cell(c) $cell(alpha) $cell(beta) $cell(gamma)"
165    puts $fp "/"
166    close $fp
167    global tcl_platform
168    # Save the current exp file
169    savearchiveexp
170    # disable the file changed monitor
171    set expgui(expModifiedLast) 0
172    set expnam [file root [file tail $expgui(expfile)]]
[268]173    # save the previous phase list
174    set expgui(oldphaselist) $expmap(phaselist)
[92]175    catch {
176        if {$tcl_platform(platform) == "windows"} {
177            exec [file join $expgui(gsasexe) exptool.exe] $expnam \
178                    < exptool.in >& exptool.out
179        } else {
180            exec [file join $expgui(gsasexe) exptool] $expnam \
181                    < exptool.in >& exptool.out
182        }
[113]183    } errmsg
[92]184    # load the revised exp file
185    loadexp $expgui(expfile)
186    set fp [open exptool.out r]
187    set out [read $fp]
188    close $fp
189    destroy $np
[113]190    if {$errmsg != ""} {
191        append errmsg "\n" $out
192    } else {
193        set errmsg $out
194    }
[321]195    if {$expgui(showexptool)} {
196        ShowBigMessage \
197                $np \
198                "Please review the result from adding the phase" \
199                $errmsg
200    }
[92]201    file delete exptool.in exptool.out
[237]202    # now select the new phase
203    SelectOnePhase [lindex $expmap(phaselist) end]   
[92]204}
205
206proc MakeAddHistBox {} {
207    global expmap newhist
208
209    # --> should check here if room for another histogram, but only texture
210    # folks will ever need that
211
212    set np .newhist
213    catch {destroy $np}
214    toplevel $np
[321]215    bind $np <Key-F1> "MakeWWWHelp expgui3.html AddHist"
[92]216
217    grid [label $np.l0 -text "Adding new histogram"] \
218            -column 0 -row 0 -sticky ew -columnspan 7
219    grid [label $np.l1 -text "Data file:"] -column 0 -row 1 
[132]220    grid [label $np.t1 -textvariable newhist(rawfile) -bd 2 -relief ridge] \
221            -column 1 -row 1 -columnspan 3 -sticky ew
[92]222    grid [button $np.b1 -text "Select File" \
223            -command "getrawfile $np" \
224            ] -column 4 -row 1
225
226    grid [label $np.lbank -text "Select bank" -anchor w] -column 1 -row 2 -sticky w
227    grid [frame $np.bank]  -column 2 -row 2 -columnspan 7 -sticky ew
228
229    grid [label $np.l2 -text "Instrument\nParameter file:"] -column 0 -row 3
[132]230    grid [label $np.t2 -textvariable newhist(instfile) -bd 2 -relief ridge] \
231            -column 1 -row 3 -columnspan 3 -sticky ew
[92]232    grid [button $np.b2 -text "Select File" \
233            -command "getinstfile $np" \
234            ] -column 4 -row 3
235
236    grid [label $np.lset -text "Select set" -anchor w] -column 1 -row 4 -sticky w
237    grid [frame $np.set]  -column 2 -row 4 -columnspan 7 -sticky ew
238
239    grid [label $np.l3 -text "Usable data limit:"] -column 0 -row 5 -rowspan 2 
240    grid [entry $np.e3 -width 12 -textvariable newhist(2tLimit) \
241            ] -column 1 -row 5 -rowspan 2 
242    grid [radiobutton $np.cb3 -text "D-min" -variable newhist(LimitMode) \
243            -value 0] -column 2 -row 5 -sticky w
[167]244    grid [radiobutton $np.cb4 -text "TOF/2-Theta Max" -variable newhist(LimitMode)\
[92]245            -value 1] -column 2 -row 6 -sticky w
246   
[321]247    grid [frame $np.f6] -column 0 -row 7 -columnspan 5 -sticky ew
[92]248    grid [button $np.f6.b6a -text Add \
249            -command "addhist $np"] -column 0 -row 0
250    bind $np <Return> "addhist $np"
251    grid [button $np.f6.b6b -text Cancel \
252            -command "destroy $np"] -column 1 -row 0
[321]253    grid [button $np.f6.help -text Help -bg yellow \
254            -command "MakeWWWHelp expgui3.html AddHist"] \
255            -column 2 -row 0 -sticky e
256    grid columnconfigure $np.f6 2 -weight 1
[167]257
[232]258    grid [button $np.f6a -text "Run\nRAWPLOT" -command RunRawplot] \
259            -column 4 -row 5 -rowspan 2
260   
[92]261    grid columnconfigure $np 3 -weight 1
[232]262   
[92]263    wm title $np "add new histogram"
264
265    if {[string trim $newhist(rawfile)] != {}} {
266        validaterawfile $np $newhist(rawfile)
267    }
268    if {[string trim $newhist(instfile)] != {}} {
269        validateinstfile $np $newhist(instfile)
270    }
271    set newhist(banknum) {}
272    set newhist(setnum) {}
273    #    for {set i 0} {$i<100} {incr i} {set newhist(bank$i) 0}
274    #    for {set i 0} {$i<100} {incr i} {set newhist(set$i) 0}
275
276    # grab focus, etc.
277    putontop $np
278
279    tkwait window $np
280
281    # fix focus...
282    afterputontop
283}
284
285# convert a file to Win-95 direct access
286proc WinCvt {file} {
287    global expgui
288    if ![file exists $file] {
289        tk_dialog .warn "Convert Error" \
290                "File $file does not exist" question 0 "OK"
291        return
292    }
293
294    set tmpname "[file join [file dirname $file] tempfile.xxx]"
295    set oldname "[file rootname $file].org"
296    if [file exists $oldname] {
297        set ans [tk_dialog .warn "OK to overwrite?" \
298                "File [file tail $oldname] exists in [file dirname $oldname]. OK to overwrite?" question 0 \
299                "Yes" "No"]
300        if $ans return
301        catch {file delete $oldname}
302    }
303
304    if [catch {
305        set in [open $file r]
306        # needed to test under UNIX
307        set out [open $tmpname w]
308        fconfigure $out -translation crlf
309        set len [gets $in line]
310        if {$len > 160} {
311            # this is a UNIX file. Hope there are no control characters
312            set i 0
313            set j 79
314            while {$j < $len} {
315                puts $out [string range $line $i $j]
316                incr i 80
317                incr j 80
318            }
319        } else {
320            while {$len >= 0} {
321                append line "                                        "
322                append line "                                        "
323                set line [string range $line 0 79]
324                puts $out $line
325                set len [gets $in line]
326            }
327        }
328        close $in
329        close $out
330        file rename $file $oldname
331        file rename $tmpname $file
332    } errmsg] {
333        tk_dialog .warn Notify "Error in conversion:\n$errmsg" warning 0 OK
334    }
335    return $file
336}
337
338proc getrawfile {np} {
339    global newhist tcl_platform
340    if {$tcl_platform(platform) == "windows"} {
341        set inp [
342        tk_getOpenFile -parent $np -initialfile $newhist(rawfile) -filetypes {
343            {"Data files" .GSAS} {"Data files" .GSA} 
344            {"Data files" .RAW}  {"All files" *}
345        }
346        ]
347    } else {
348        set inp [
349        tk_getOpenFile -parent $np -initialfile $newhist(rawfile) -filetypes {
350            {"Data files" .GSA*} {"Data files" .RAW} 
351            {"Data files" .gsa*} {"Data files" .raw} 
352            {"All files" *}
353        } 
354        ]
355    }
356    validaterawfile $np $inp
357}
358
359proc validaterawfile {np inp} {
360    global tcl_platform expgui newhist
361    if {$inp == ""} return
362    if [catch {set in [open $inp r]}] {
363        tk_dialog .err "Open error" "Unable to open file $inp" \
364                error 0 OK
365        return 
366    }
367    set newhist(banklist) {}
368    foreach child [pack slaves $np.bank] {destroy $child}
369    # is this a properly formatted file?
370    if {$tcl_platform(platform) == "windows"} {
371        # are lines the correct length?
372
373        #--> can we check that lines are terminated CR-LF?
374
375        set i 0
376        while {[set len [gets $in line]] > 0} {
377            incr i
378            if {$len != 80} {
379                set ans [tk_dialog .err "Read error" \
380                        "File $inp is not direct access. OK to convert?" \
381                        error 0 OK QUIT]
382                if {$ans == 0} {
383                    close $in
384                    WinCvt $inp
385                    set i 0
386                    set in [open $inp r]
387                    set line {}
388                } else {
389                    return
390                }
391            }
392            # scan for BANK lines
393            if {[string first BANK $line] == 0} {
394                scan $line "BANK%d" num
395                lappend newhist(banklist) $num
396            }
397            # check for "Instrument parameter file" line
398            if {$i == 2 && [string first "Instrument parameter" $line] == 0} {
399                validateinstfile $np \
400                        [file join [file dirname $inp] \
401                        [string trim [string range $line 26 end]]]
402            }
403        }
404    } else {
405        # is the file one big record?
406        set len [gets $in line]
[113]407        # a instrument parameter file should be more than 4 lines
408        if {$len <= 4*80} {
[92]409            set ans [tk_dialog .err "Read error" \
410                    "File $inp is not direct access. OK to convert?" \
411                    error 0 OK QUIT]
412            if {$ans == 0} {
413                close $in
414                set oldname ${inp}.original
415                file rename $inp $oldname
416                if [catch {
417                    exec [file join $expgui(gsasexe) convstod] < \
418                            $oldname > $inp
419                } errmsg] {
420                    tk_dialog .warn Notify \
421                            "Error in conversion:\n$errmsg" warning 0 OK
422                }
423                set in [open $inp r]
424                set line {}
425            } else {
426                return
427            }
428        }
429        seek $in 0
430        set i 0
431        while {[string length [set line [read $in 80]]] == 80} {
432            incr i
433            # scan for BANK lines
434            if {[string first BANK $line] == 0} {
435                scan $line "BANK%d" num
436                lappend newhist(banklist) $num
437            }
438            # check for "Instrument parameter file" line
439            if {$i == 2 && [string first "Instrument parameter" $line] == 0} {
440                validateinstfile $np \
441                        [file join [file dirname $inp] \
442                        [string trim [string range $line 26 end]]]
443            }
444        }
445    }
446    # were banks found?
447    if {$newhist(banklist) == ""} {
448        tk_dialog .err "Read error" \
449                "File $inp has no BANK lines. This is not a valid GSAS data file." \
450                error 0 OK
451        return
452    }
[132]453    # don't use a full path unless needed
454    if {[pwd] == [file dirname $inp]} {
455        set newhist(rawfile) [file tail $inp]
456    } else {
457        set newhist(rawfile) $inp
458    }
[92]459    foreach i $newhist(banklist) {
460        pack [radiobutton $np.bank.$i -text $i \
461                -variable newhist(banknum) -value $i] -side left
[132]462        # only 1 choice, so set it
463        if {[llength $newhist(banklist)] == 1} {set newhist(banknum) $i}
[92]464    }
465}
466
467proc getinstfile {np} {
468    global newhist tcl_platform
469    if {$tcl_platform(platform) == "windows"} {
470        set inp [
471        tk_getOpenFile -parent $np -initialfile $newhist(instfile) -filetypes {
472            {"Inst files" .INST} {"Inst files" .INS} 
473            {"Inst files" .PRM} {"All files" *}
474        }
475        ]
476    } else {
477        set inp [
478        tk_getOpenFile -parent $np -initialfile $newhist(instfile) -filetypes {
479            {"Inst files" .INS*} {"Inst files" .ins*} 
480            {"Inst files" .PRM}  {"Inst files" .prm} 
481            {"All files" *}
482        }
483        ]
484    }
485    validateinstfile $np $inp
486}
487
488proc validateinstfile {np inp} {
489    global tcl_platform expgui newhist
490    if {$inp == ""} return
491    if [catch {set in [open $inp r]}] {
492        tk_dialog .err "Open error" "Unable to open file $inp" \
493                error 0 OK
494        return 
495    }
496    set newhist(instbanks) {}
497    foreach child [pack slaves $np.set] {destroy $child}
498    # is this a properly formatted file?
499    if {$tcl_platform(platform) == "windows"} {
500        # are lines the correct length?
501
502        #--> can we check that lines are terminated CR-LF?
503
504        while {[set len [gets $in line]] > 0} {
505            if {$len != 80} {
506                set ans [tk_dialog .err "Read error" \
507                        "File $inp is not direct access. OK to convert?" \
508                        error 0 OK QUIT]
509                if {$ans == 0} {
510                    close $in
511                    WinCvt $inp
512                    set in [open $inp r]
513                    set line {}
514                } else {
515                    return
516                }
517            }
518            # scan for the INS   BANK line
519            if {[string first "INS   BANK" $line] == 0} {
520                set newhist(instbanks) \
521                        [string trim [string range $line 12 end]]
522            }
523        }
524    } else {
525        # is the file one big record?
526        set len [gets $in line]
527        if {$len <= 80} {
528            set ans [tk_dialog .err "Read error" \
529                    "File $inp is not direct access. OK to convert?" \
530                    error 0 OK QUIT]
531            if {$ans == 0} {
532                close $in
533                set oldname ${inp}.original
534                file rename $inp $oldname
535                if [catch {
536                    exec [file join $expgui(gsasexe) convstod] < \
537                            $oldname > $inp
538                } errmsg] {
539                    tk_dialog .warn Notify \
540                            "Error in conversion:\n$errmsg" warning 0 OK
541                }
542                set in [open $inp r]
543                set line {}
544            } else {
545                return
546            }
547        }
548        seek $in 0
549        while {[string length [set line [read $in 80]]] == 80} {
550            # scan for the INS   BANK line
551            if {[string first "INS   BANK" $line] == 0} {
552                set newhist(instbanks) \
553                        [string trim [string range $line 12 end]]
554            }
555        }
556    }
557    # were banks found?
558    if {$newhist(instbanks) == ""} {
559        tk_dialog .err "Read error" \
560                "File $inp has no INS   BANK line. This is not a valid GSAS Instrument Parameter file." \
561                error 0 OK
562        return
563    }
[132]564    # don't use a full path unless needed
565    if {[pwd] == [file dirname $inp]} {
566        set newhist(instfile) [file tail $inp]
567    } else {
568        set newhist(instfile) $inp
569    }
[92]570    for {set i 1} {$i <= $newhist(instbanks)} {incr i} {
571        pack [radiobutton $np.set.$i -text $i \
572                -variable newhist(setnum) -value $i] -side left
[132]573        if {$newhist(instbanks) == 1} {set newhist(setnum) $i}
[92]574    }
575}
576
577proc addhist {np} {
[232]578    global expgui newhist tcl_platform
[92]579    # validate the input
580    set err {}
581    if {[string trim $newhist(rawfile)] == ""} {
582        append err "  No data file specified\n"
583    }
584    if {[string trim $newhist(instfile)] == ""} {
585        append err "  No instrument parameter file specified\n"
586    }
587    if {[string trim $newhist(banknum)] == ""} {
588            append err "  Bank number must be specified\n"
589    } elseif {[catch {expr $newhist(banknum)}]} {
590            append err "  Bank number is not valid\n"
591    }
592    if {[string trim $newhist(setnum)] == ""} {
593        append err "  Parameter set number must be specified\n"
594    } elseif {[catch {expr $newhist(setnum)}]} {
595        append err "  Parameter set number is not valid\n"
596    }
597    if {[string trim $newhist(2tLimit)] == ""} {
598        append err "  2Theta/d-space limit must be specified\n"
599    } elseif {[catch {expr $newhist(2tLimit)}]} {
600        append err "  The 2Theta/d-space limit is not valid\n"
601    }
602    if {[string trim $newhist(LimitMode)] == ""} {
603        append err "  Please choose between either a 2Theta or d-space limit\n"
604    }
605
606    if {$err != ""} {
[321]607#       tk_dialog .phaseerr "Add Histogram Error" \
608#               "The following error(s) were found in your input:\n$err" \
609#               error 0 "OK"
610        MyMessageBox -parent $np -title  "Add Histogram Error" \
611                -message "The following error(s) were found in your input:\n$err" \
612                -icon error -type ok -default ok \
613                -helplink "expgui3.html AddHistErr"
[92]614        return
615    }
616
617    # ok do it!
618    set fp [open exptool.in w]
619    puts $fp "H"
[232]620    if {$tcl_platform(platform) == "windows"} {
621        puts $fp [file attributes $newhist(rawfile) -shortname]
622        puts $fp [file attributes $newhist(instfile) -shortname]
623    } else {
624        puts $fp $newhist(rawfile)
625        puts $fp $newhist(instfile)
626    }
[92]627    puts $fp $newhist(banknum)
628    puts $fp $newhist(setnum)
629    if {$newhist(LimitMode)} {
630        puts $fp "T"
631    } else {
632        puts $fp "D"
633    }
634    puts $fp "$newhist(2tLimit)"
635    puts $fp "/"
636    puts $fp "X"
637    puts $fp "X"
638    close $fp
639    global tcl_platform
640    # Save the current exp file
641    savearchiveexp
642    # disable the file changed monitor
643    set expgui(expModifiedLast) 0
644    set expnam [file root [file tail $expgui(expfile)]]
645    catch {
646        if {$tcl_platform(platform) == "windows"} {
647            exec [file join $expgui(gsasexe) exptool.exe] $expnam \
648                    < exptool.in >& exptool.out
649        } else {
650            exec [file join $expgui(gsasexe) exptool] $expnam \
651                    < exptool.in >& exptool.out
652        }
[113]653    } errmsg
[92]654    # load the revised exp file
655    loadexp $expgui(expfile)
656    set fp [open exptool.out r]
657    set out [read $fp]
658    close $fp
659    destroy $np
[113]660    if {$errmsg != ""} {
661        append errmsg "\n" $out
662    } else {
663        set errmsg $out
664    }
[321]665    if {$expgui(showexptool)} {
666        ShowBigMessage \
667                $np \
668                "Please review the result from adding the phase" \
669                $errmsg
670    }
[92]671    file delete exptool.in exptool.out
672}
673
[232]674proc RunRawplot {} {
675    global newhist tcl_platform
676    # for Windows put a message on top, in case file names must be shortened
677    if {$tcl_platform(platform) == "windows"} {
678        set f1 {}
679        catch {set f1 [file nativename \
680                    [file attributes $newhist(rawfile) -shortname]]}
681        set f2 {}
682        catch {set f2 [file nativename \
683                [file attributes $newhist(instfile) -shortname]]}
684        if {$f1 != "" || $f2 != ""} {
685            set msg "Note: input to RAWPLOT\n"
686            if {$f1 != ""} {append msg "data file: $f1\n"}
687            if {$f2 != ""} {append msg "instrument file: $f2"}
688            MyMessageBox -icon info -message $msg -parent .
689        }
690    }
691    # start RAWPLOT
692    runGSASwEXP rawplot 1
693}
694
[268]695proc MakeAddAtomsBox {phase "atomlist {}"} {
696    global expmap expgui
[92]697
[179]698    # is there room for more atoms? Well, we will check this someday
[92]699    if {$phase == ""} return
700    if {[llength $phase] != 1} return
701
[179]702    set top .newatoms
703    catch {destroy $top}
704    toplevel $top
[321]705    bind $top <Key-F1> "MakeWWWHelp expgui2.html addatoms"
[92]706
[179]707    grid [label $top.l1 -relief groove -bd 4 -anchor center\
708            -text "Adding atoms to phase #$phase"] \
709            -column 0 -row 0 \
710            -sticky we -columnspan 10
711   
712    grid [canvas $top.canvas \
713            -scrollregion {0 0 5000 500} -width 0 -height 250 \
714            -yscrollcommand "$top.scroll set"] \
715            -column 0 -row 2 -columnspan 4 -sticky nsew
716    grid columnconfigure $top 3 -weight 1
717    grid rowconfigure $top 2 -weight 1
718    grid rowconfigure $top 1 -pad 5
719    scrollbar $top.scroll \
720            -command "$top.canvas yview"
721    frame $top.canvas.fr
722    $top.canvas create window 0 0 -anchor nw -window $top.canvas.fr
723
724    set np $top.canvas.fr
725    set row 0
726    set col 0
727    foreach i {Atom\ntype Name x y z Occ Uiso Use} {
[92]728        grid [label $np.l_${row}$i -text $i] -column [incr col] -row $row
729    }
730
[179]731    set expgui(SetAddAtomsScroll) 0
[268]732    set i [llength $atomlist]
733    if {$i == 0} {incr i}
734    for {set j 0} {$j < $i} {incr j} {
735        MakeAddAtomsRow $top
736    }
737    set row 0
738    foreach item $atomlist {
739        incr row
740        foreach val $item w {n x y z t o u} {
741            if {$val != ""} {
742                $np.e${row}$w delete 0 end
743                $np.e${row}$w insert end $val
744            }
745        }
746    }
[179]747    bind $top <Configure> "SetAddAtomsScroll $top"
[268]748    grid rowconfigure $top 3 -min 10
[179]749    grid [button $top.b1 -text "Add Atoms"\
[268]750            -command "addatom $phase $top"] -column 0 -row 5 -sticky w
[179]751    bind $top <Return> "addatom $phase $top"
752    grid [button $top.b2 -text Cancel \
[268]753            -command "destroy $top"] -column 1 -row 5 -sticky w
[321]754    grid [button $top.help -text Help -bg yellow \
755            -command "MakeWWWHelp expgui2.html addatoms"] \
756            -column 0 -columnspan 2 -row 4
[179]757
[268]758    # get the input formats if not already defined
759    GetImportFormats
760    if {[llength $expgui(importFormatList)] > 0} {
761        grid [frame $top.fr -bd 4 -relief groove] \
762                -column 3 -row 5 -columnspan 2 -sticky e
763        grid [button $top.fr.b3 -text "Import atoms from: " \
764                -command "ImportAtoms \$expgui(importFormat) $top"] \
765                -column 0 -row 0 -sticky e
766        eval tk_optionMenu $top.fr.b4 expgui(importFormat) \
767                $expgui(importFormatList)
768        grid $top.fr.b4 -column 1 -row 0 -sticky w
769        grid rowconfig $top.fr 0 -pad 10
770        grid columnconfig $top.fr 0 -pad 10
771        grid columnconfig $top.fr 1 -pad 10
772    }
773
774    grid [button $top.b3 -text  "More atom boxes" \
[179]775            -command "MakeAddAtomsRow $top"] -column 3 \
776            -columnspan 2 -row 4 -sticky e
777   
778    wm title $top "add new atom"
779
780    # grab focus, etc.
781    putontop $top
782
783    tkwait window $top
784
785    # fix focus...
786    afterputontop
787}
788
789proc MakeAddAtomsRow {top} {
790    set np $top.canvas.fr
[92]791    set col -1
[179]792    set row 1
793    # find an empty row
794    while {![catch {grid info $np.e${row}t}]} {incr row}
795    grid [label $np.e${row}num -text $row] -column [incr col]  -row $row
[92]796    grid [entry $np.e${row}t -width 5] -column [incr col]  -row $row
797    grid [entry $np.e${row}n -width 8] -column [incr col]  -row $row
798    foreach i {x y z o u} {
[179]799        grid [entry $np.e${row}$i -width 9] -column [incr col] -row $row
[92]800    }
[179]801    grid [checkbutton $np.e${row}use -variable expgui(UseAtom$row)] \
802            -column [incr col] -row $row
[92]803    # default occupancy
804    $np.e${row}o delete 0 end
805    $np.e${row}o insert end 1.0
806    # default Uiso
807    $np.e${row}u delete 0 end
808    $np.e${row}u insert end 0.025
[268]809    # default label
[92]810    $np.e${row}n delete 0 end
811    $np.e${row}n insert end (default)
[179]812    # use by default
813    $np.e${row}use select
[92]814
[179]815    SetAddAtomsScroll $top
[268]816    return $row
[179]817}
[92]818
[179]819proc SetAddAtomsScroll {top} {
820    global expgui
821    if $expgui(SetAddAtomsScroll) return
822    # prevent reentrance
823    set expgui(SetAddAtomsScroll) 1
824    update
825    set sizes [grid bbox $top.canvas.fr]
826    $top.canvas config -scrollregion $sizes -width [lindex $sizes 2]
827    # use the scroll for BIG atom lists
828    if {[lindex $sizes 3] > [winfo height $top.canvas]} {
829        grid $top.scroll -sticky ns -column 4 -row 2
830    } else {
831        grid forget $top.scroll 
832    }
833    update
834    set expgui(SetAddAtomsScroll) 0
[92]835}
836
[179]837proc addatom {phase top} {
[92]838    global expgui env
[179]839    set np $top.canvas.fr
840    set row 0
841    # loop over the defined rows
[92]842    set err {}
[179]843    set atomlist {}
844    while {![catch {grid info $np.e[incr row]t}]} {
845        if !{$expgui(UseAtom$row)} continue
846        # ignore blank entries
847        set line {}
848        foreach i {t x y z} {
849            append line [string trim [$np.e${row}$i get]]
[92]850        }
[179]851        if {$line == ""} continue
852        # validate the input
853        if {[set type [string trim [$np.e${row}t get]]] == ""} {
854            append err "  line $row: No atom type specified\n"
855        }
856        set name [string trim [$np.e${row}n get]]
857        if {$name == "(default)"} {set name "/"}
858        if {$name == ""} {set name "/"}
859        foreach i {x y z o u} n {x y z Occ Uiso} {
860            if {[set $i [string trim [$np.e${row}$i get]]] == ""} {
861                append err "  line $row: No value specified for $n\n"
862            } elseif {[catch {expr [set $i]}]} {
863                append err "  line $row: The value for $n is invalid\n"
864            }
865        }
866        lappend atomlist "$type $x $y $z $o $name I $u"
867    }   
[92]868    if {$err != ""} {
[179]869        MyMessageBox -icon warning -message "Note Errors:\n$err" -parent $top
[92]870        return
871    }
[179]872    if {[llength $atomlist] == 0} {
873        MyMessageBox -icon warning -message "No atoms to load!" -parent $top
874        return
875    }
876    # ok add the atoms!
[92]877    set fp [open exptool.in w]
878    puts $fp "A"
879    puts $fp $phase
[179]880    # number of atoms
881    puts $fp [llength $atomlist]
882    foreach atomline $atomlist {
883        puts $fp $atomline
884    }
[92]885    close $fp
886    # needed in UNIX
887    set env(ATOMDATA) [file join $expgui(gsasdir) data atmdata.dat]
888    # needed in Windows
889    set env(GSAS) [file nativename $expgui(gsasdir)]
[179]890
[92]891    global tcl_platform
892    # Save the current exp file
893    savearchiveexp
894    # disable the file changed monitor
895    set expgui(expModifiedLast) 0
896    set expnam [file root [file tail $expgui(expfile)]]
897    catch {
898        if {$tcl_platform(platform) == "windows"} {
899            exec [file join $expgui(gsasexe) exptool.exe] $expnam \
900                    < exptool.in >& exptool.out
901        } else {
902            exec [file join $expgui(gsasexe) exptool] $expnam \
903                    < exptool.in >& exptool.out
904        }
[113]905    } errmsg
[92]906    # load the revised exp file
907    loadexp $expgui(expfile)
908    set fp [open exptool.out r]
909    set out [read $fp]
910    close $fp
[179]911    destroy $top
[113]912    if {$errmsg != ""} {
913        append errmsg "\n" $out
914    } else {
915        set errmsg $out
916    }
[321]917    if {$expgui(showexptool)} {
918        ShowBigMessage \
919                $top \
920                "Please review the result from adding the atom(s)" \
921                $errmsg
922    }
[92]923    file delete exptool.in exptool.out
924}
[254]925
926#----------------------------------------------
927# commands to modify a group of selected atoms |
928#----------------------------------------------
929
930# make the dialog to choose an action
931proc MakeXformAtomsBox {phase} {
932    global expgui expmap
933    set numberList {}
934    set p $expgui(curPhase)
935    foreach AtomIndex $expgui(selectedatomlist) {
936        # get atom number & phase
937        set tuple [lindex $expmap(atomlistboxcontents) $AtomIndex]
938        lappend numberList [lindex $tuple 0]
939    }
940    if {$numberList == ""} return
941    if {[llength $numberList] > 1} {
942        set suffix s
943        set suffixy "ies"
944    } else {
945        set suffix ""
946        set suffixy "y"
947    }
948    set w .global
949    catch {destroy $w}
950    toplevel $w
951    wm title $w "Edit Atomic Parameter -- phase #$phase"
[321]952    bind $w <Key-F1> "MakeWWWHelp expgui2.html xform"
[254]953    # this needs to track by phase
954    grid [label $w.0 \
955            -text "Modifying atom${suffix} [CompressList $numberList] Phase $phase" \
956            -bg yellow -anchor center] -row 0 -column 0 -columnspan 10 \
957            -sticky nsew
958    grid rowconfigure $w 0 -pad 5
959    grid rowconfigure $w 1 -minsize 2
960
961    grid [TitleFrame $w.1 -bd 6 -relief groove -text "Modify coordinates"] \
962            -row 2 -column 0 -columnspan 10 -sticky news
963    set w1 [$w.1 getframe]
964    set row 0
965    foreach v {x y z} {
966        incr row
967        set col -1
968        grid [label $w1.l$v -text "new $v   =   "] -column [incr col] -row $row
969        foreach o {x y z} {
970            grid [entry $w1.e${v}${o} -width 6] -column [incr col] -row $row
971            $w1.e${v}${o} delete 0 end
972            if {$v == $o} {
973                $w1.e${v}${o} insert end "1.0"
974            } else {
975                $w1.e${v}${o} insert end "0."
976            }
977            grid [label $w1.p${v}${o} -text " $o  +  "] \
978                    -column [incr col] -row $row
979        }
980        grid [entry $w1.e${v} -width 6] -column [incr col] -row $row
981        $w1.e${v} delete 0 end
982        $w1.e${v} insert end "0."
983    }
984    grid [button $w1.do -text "Transform Coordinates" \
985            -command "XformAtomsCoord $phase [list $numberList] $w1" \
986            ] -row [incr row] -column 0 -columnspan 10
987
988    grid rowconfigure $w 3 -minsize 5
989    grid [TitleFrame $w.4 -bd 6 -relief groove -text "Modify occupanc${suffixy}"] \
990            -row 4 -column 0 -columnspan 10 -sticky news
991    set w2 [$w.4 getframe]
992    grid [label $w2.1 -text "Occupancy: "] -row 1 -column 0
993    grid [entry $w2.e -width 10] -column 1 -row 1
994    $w2.e delete 0 end
995    $w2.e insert end 1.0
996    grid columnconfigure $w2 2 -weight 1
997    grid [button $w2.do -text "Set Occupanc${suffixy}" \
998            -command "XformAtomsOcc $phase [list $numberList] $w2" \
999            ] -row 2 -column 0 -columnspan 10
1000
1001    grid rowconfigure $w 5 -minsize 5
1002    grid [TitleFrame $w.6 -bd 6 -relief groove \
1003            -text "Modify Displacement Parameter$suffix"] \
1004            -row 6 -column 0 -columnspan 10 -sticky news
1005    set w2 [$w.6 getframe]
1006    grid [label $w2.1 -text "Uiso or Uequiv: "] -row 1 -column 0
1007    grid [entry $w2.e -width 10] -column 1 -row 1
1008    $w2.e delete 0 end
1009    $w2.e insert end 0.025
1010    grid columnconfigure $w2 2 -weight 1
1011    grid [button $w2.do -text "Set U" \
1012            -command "XformAtomsU $phase [list $numberList] $w2" \
1013            ] -row 2 -column 0 -columnspan 10
1014    grid [frame $w2.f] -row 3 -column 0 -columnspan 10
1015    grid [button $w2.f.iso -text "Set Isotropic" \
1016            -command "XformAtomsU $phase [list $numberList] iso" \
1017            ] -row 0 -column 0
1018    grid [button $w2.f.aniso -text "Set Anisotropic" \
1019            -command "XformAtomsU $phase [list $numberList] aniso" \
1020            ] -row 0 -column 1
1021
1022    grid rowconfigure $w 5 -minsize 5
1023    grid [TitleFrame $w.8 -bd 6 -relief groove \
1024            -text "Erase Atom$suffix"] \
1025            -row 8 -column 0 -columnspan 10 -sticky news
1026    set w2 [$w.8 getframe]
1027    grid [button $w2.do -text "Erase Atom${suffix}" \
1028            -command "EraseAtoms $phase [list $numberList] $w" \
1029            ] -row 2 -column 0 -columnspan 10
1030
1031
1032    grid rowconfigure $w 9 -minsize 5
[321]1033    grid [frame $w.b] -row 10 -column 0 -columnspan 10 -sticky ew
1034    pack [button $w.b.3 -text Close -command "destroy $w"] -side left \
1035            -padx 5 -pady 5
1036    pack [button $w.b.help -text Help -bg yellow \
1037            -command "MakeWWWHelp expgui2.html xform"] -side right \
1038            -padx 5 -pady 5
[254]1039    bind $w <Return> "destroy $w"
1040
1041    # force the window to stay on top
1042    putontop $w
1043    focus $w.b.3
1044    tkwait window $w
1045    afterputontop
1046    # if there are selected atoms, reset their display
1047    if {[llength $expgui(selectedatomlist)] != 0} editRecord
1048}
1049
1050# transform the coordinates
1051proc XformAtomsCoord {phase numberList w1} {
1052    global expgui
1053    # get the matrix
1054    foreach v {x y z} {
1055        foreach o {x y z} {
1056            set matrix(${v}${o}) [$w1.e${v}${o} get]
1057        }
1058        set matrix(${v}) [$w1.e${v} get]
1059    }
1060    foreach atom $numberList {
1061        foreach v {x y z} {
1062            set $v [atominfo $phase $atom $v]
1063        }
1064        foreach v {x y z} {
1065            set new$v $matrix(${v})
1066            foreach o {x y z} {
1067                set new$v [expr [set new$v] + $matrix(${v}${o})*[set $o]]
1068            }
1069            atominfo $phase $atom $v set [set new$v]
1070        }
1071        incr expgui(changed)
1072    }
1073    DisplayAllAtoms noreset
1074}
1075
1076# set the occupancies to a single value
1077proc XformAtomsOcc {phase numberList w2} {
1078    global expgui
1079    # get the value
1080    set val [$w2.e get]
1081    foreach atom $numberList {
1082        atominfo $phase $atom frac set $val
1083        incr expgui(changed)
1084    }
1085    DisplayAllAtoms noreset
1086}
1087
1088# transform Uiso or Uij; if anisotropic set Uequiv to Uij
1089proc XformAtomsU {phase numberList w2} {
1090    global expgui
1091    if {$w2 == "iso"} {
1092        foreach atom $numberList {
1093            if {[atominfo $phase $atom temptype] != "I"} {
1094                atominfo $phase $atom temptype set I
1095            }
1096        }
1097    } elseif {$w2 == "aniso"} {
1098        foreach atom $numberList {
1099            if {[atominfo $phase $atom temptype] == "I"} {
1100                atominfo $phase $atom temptype set A
1101            }
1102        }
1103    } else {
1104        # get the value
1105        set val [$w2.e get]
1106        foreach atom $numberList {
1107            if {[atominfo $phase $atom temptype] == "I"} {
1108                atominfo $phase $atom Uiso set $val
1109            } else {
1110                atominfo $phase $atom U11 set $val
1111                atominfo $phase $atom U22 set $val
1112                atominfo $phase $atom U33 set $val
1113                atominfo $phase $atom U12 set 0.0
1114                atominfo $phase $atom U13 set 0.0
1115                atominfo $phase $atom U23 set 0.0
1116            }
1117            incr expgui(changed)
1118        }
1119    }
1120    DisplayAllAtoms noreset
1121}
1122
1123# confirm and erase atoms
1124proc EraseAtoms {phase numberList w2} {
1125    global expgui
1126    if {[llength $numberList] <= 0} return
1127    # make a list of atoms
1128    foreach atom $numberList {
1129        append atomlist "\n\t$atom  [atominfo $phase $atom label]"
1130    }
1131    set msg "OK to remove the following [llength $numberList] atoms from phase $phase:$atomlist"
1132    set val [MyMessageBox -parent $w2 -type okcancel -icon warning \
1133            -default cancel -title "Confirm Erase" -message $msg]
1134    if {$val == "ok"} {
1135        foreach atom $numberList {
1136            EraseAtom $atom $phase
1137            incr expgui(changed)
1138        }
1139        mapexp
1140        DisplayAllAtoms
1141        destroy $w2
1142    }
1143}
1144
[268]1145proc ImportPhase {format np} {
1146    global expgui
1147    foreach item $expgui(extensions_$format) {
1148        lappend typelist [list $format $item]
1149    }
1150    lappend typelist [list "All files" *]
1151    set file [tk_getOpenFile -parent $np -filetypes $typelist]
1152    if {![file exists $file]} return
1153    # read in the file
1154    set input [$expgui(proc_$format) $file]
1155    catch {
1156        $np.bf.b1 config -text "Continue" -command "addphase $np; AddAtomsList"
1157        bind $np <Return> "addphase $np; AddAtomsList"
1158    }
1159    catch {
1160        $np.t1 delete 0 end
1161        $np.t1 insert end "from $file"
1162    }
1163    $np.t2 delete 0 end
1164    $np.t2 insert end [lindex $input 0]
1165    foreach i {.e1a .e1b .e1c .e2a .e2b .e2g} val [lindex $input 1] {
1166        $np.f$i delete 0 end
1167        $np.f$i insert end $val
1168    }
1169    set expgui(coordList) [lindex $input 2]
[284]1170    set msg [lindex $input 3]
1171    if {$msg != ""} {
1172        grid [label $np.msg -text $msg -fg red -justify left -bd 4 -relief raised] \
1173                -column 0 -columnspan 8 -row 20 -sticky ew
1174    }
[268]1175}
1176
1177proc ImportAtoms {format top} {
1178    global expgui
1179    foreach item $expgui(extensions_$format) {
1180        lappend typelist [list $format $item]
1181    }
1182    lappend typelist [list "All files" *]
1183    set file [tk_getOpenFile -parent $top -filetypes $typelist]
1184    if {![file exists $file]} return
1185    # read in the file
1186    set input [$expgui(proc_$format) $file]
1187    # add atoms to table
1188    foreach item [lindex $input 2] {
1189        set row [MakeAddAtomsRow $top]
1190        set np $top.canvas.fr
1191        foreach val $item w {n x y z t o u} {
1192            if {$val != ""} {
1193                $np.e${row}$w delete 0 end
1194                $np.e${row}$w insert end $val
1195            }
1196        }
1197    }
1198}
1199
1200proc AddAtomsList {} {
1201    global expgui expmap
1202    # find the new phase
1203    set phase {}
1204    foreach p $expmap(phaselist) {
1205        if {[lsearch $expgui(oldphaselist) $p] == -1} {
1206            set phase $p
1207            break
1208        }
1209    }
1210    if {$phase == ""} return
1211    MakeAddAtomsBox $phase $expgui(coordList)
1212}
1213
1214# get the input formats by sourcing files named import_*.tcl
1215proc GetImportFormats {} {
1216    global expgui tcl_platform
1217    # only needs to be done once
1218    if [catch {set expgui(importFormatList)}] {
1219        set filelist [glob -nocomplain [file join $expgui(scriptdir) import_*.tcl]]
1220        foreach file $filelist {
1221            source $file
1222            lappend expgui(importFormatList) $description
1223            if {$tcl_platform(platform) == "unix"} {
1224                set extensions "[string tolower $extensions] [string toupper $extensions]"
1225            }
1226            set expgui(extensions_$description) $extensions
1227            set expgui(proc_$description) $procname
1228        }
1229    }
1230}
1231
1232proc MakeReplacePhaseBox {} {
1233    global expmap expgui tcl_platform
1234
1235    set expgui(coordList) {}
1236    # ignore the command if no phase is selected
1237    foreach p {1 2 3 4 5 6 7 8 9} {
1238        if {[lsearch $expmap(phaselist) $expgui(curPhase)] == -1} {
1239            return
1240        }
1241    }
1242
1243    set top .newphase
1244    catch {destroy $top}
1245    toplevel $top
[321]1246    bind $top <Key-F1> "MakeWWWHelp expgui2.html replacephase"
[268]1247
1248    grid [label $top.l1 -text "Replacing phase #$expgui(curPhase)" \
1249            -bg yellow -anchor center] -column 0 -columnspan 8 -row 0 -sticky ew
1250    grid [label $top.l3a -text "Current Space Group: "] \
1251            -column 0 -row 2 -columnspan 2 -sticky e
1252    grid [label $top.l3b -text [phaseinfo $expgui(curPhase) spacegroup]\
1253            -bd 4 -relief groove] \
1254            -column 2 -row 2  -sticky ew
1255    grid [label $top.l4 -text "New Space Group: "] \
1256            -column 0 -row 3 -columnspan 2 -sticky e
1257    grid [entry $top.t2 -width 12] -column 2 -row 3 -sticky w
1258    grid [radiobutton $top.r1 -text "Reenter current atoms"\
1259            -variable expgui(DeleteAllAtoms) -value 0] \
1260            -column 1 -row 4 -columnspan 8 -sticky w
1261    grid [radiobutton $top.r2 -text "Delete current atoms" \
1262            -variable expgui(DeleteAllAtoms) -value 1] \
1263            -column 1 -row 5 -columnspan 8 -sticky w
1264   
1265    grid [frame $top.f -bd 4 -relief groove] \
1266            -column 3 -row 2 -columnspan 3 -rowspan 4
1267    set col -1
1268    foreach i {a b c} {
1269        grid [label $top.f.l1$i -text " $i "] -column [incr col] -row 1
1270        grid [entry $top.f.e1$i -width 12] -column [incr col]  -row 1
1271        $top.f.e1$i delete 0 end
1272        $top.f.e1$i insert 0 [phaseinfo $expgui(curPhase) $i]
1273    }
1274    set col -1
1275    foreach i {a b g} var {alpha beta gamma} {
1276        grid [label $top.f.l2$i -text $i -font symbol] -column [incr col] -row 2
1277        grid [entry $top.f.e2$i -width 12] -column [incr col]  -row 2
1278        $top.f.e2$i delete 0 end
1279        $top.f.e2$i insert 0 [phaseinfo $expgui(curPhase) $var]
1280    } 
1281
1282    grid [button $top.b1 -text Continue \
1283            -command "replacephase1 $top $expgui(curPhase)"] \
1284            -column 0 -row 6 -sticky w
1285    bind $top <Return> "replacephase1 $top $expgui(curPhase)"
1286    grid [button $top.b2 -text Cancel \
1287            -command "destroy $top"] -column 1 -row 6 -sticky w
[321]1288    grid [button $top.help -text Help -bg yellow \
1289            -command "MakeWWWHelp expgui2.html replacephase"] \
1290            -column 2 -row 6
[268]1291
1292    # get the input formats if not already defined
1293    GetImportFormats
1294    if {[llength $expgui(importFormatList)] > 0} {
1295        grid [frame $top.fr -bd 4 -relief groove] \
1296                -column 2 -row 6 -columnspan 8 -sticky e
1297        grid [button $top.fr.b3 -text "Import phase from: " \
1298                -command "ImportPhase \$expgui(importFormat) $top"] \
1299                -column 0 -row 0 -sticky e
1300        eval tk_optionMenu $top.fr.b4 expgui(importFormat) \
1301                $expgui(importFormatList)
1302        grid $top.fr.b4 -column 1 -row 0 -sticky w
1303        grid rowconfig $top.fr 0 -pad 10
1304        grid columnconfig $top.fr 0 -pad 10
1305        grid columnconfig $top.fr 1 -pad 10
[284]1306#       grid columnconfig $top 4 -weight 1
1307        grid columnconfig $top 2 -weight 1
[268]1308    }
1309   
1310    wm title $top "Replace phase $expgui(curPhase)"
1311
1312    # grab focus, etc.
1313    putontop $top
1314
1315    tkwait window $top
1316
1317    # fix focus...
1318    afterputontop
1319}
1320
1321proc replacephase1 {top phase} {
1322    # validate cell & space group & save to pass
1323    global expgui expmap
1324    set expgui(SetAddAtomsScroll) 0
1325    # validate the input
1326    set err {}
1327    set spg [$top.t2 get]
1328    if {[string trim $spg] == ""} {
1329        append err "  Space group cannot be blank\n"
1330    }
1331    set cell {}
1332    foreach i {a b c a b g} lbl {a b c alpha beta gamma} n {1 1 1 2 2 2} {
1333        set $lbl [$top.f.e${n}$i get]
1334        if {[string trim [set $lbl]] == ""} {
1335            append err "  $lbl cannot be blank\n"
1336        } elseif {[catch {expr [set $lbl]}]} {
1337            append err "  [set $lbl] is not valid for $lbl\n"
1338        }
1339        lappend cell [set $lbl]
1340    }
1341
1342    if {$err != ""} {
1343        tk_dialog .phaseerr "Replace Phase Error" \
1344                "The following error(s) were found in your input:\n$err" \
1345                error 0 "OK" 
1346        return
1347    }
1348
1349    # check the space group
1350    set fp [open spg.in w]
1351    puts $fp "N"
1352    puts $fp "N"
1353    puts $fp $spg
1354    puts $fp "Q"
1355    close $fp
1356    global tcl_platform
1357    catch {
1358        if {$tcl_platform(platform) == "windows"} {
1359            exec [file join $expgui(gsasexe) spcgroup.exe] < spg.in >& spg.out
1360        } else {
1361            exec [file join $expgui(gsasexe) spcgroup] < spg.in >& spg.out
1362        }
1363    }
1364    set fp [open spg.out r]
1365    set out [read $fp]
1366    close $fp
1367    # attempt to parse out the output (fix up if parse did not work)
1368    if {[regexp "space group symbol.*>(.*)Enter a new space group symbol" \
1369            $out a b ] != 1} {set b $out}
1370    if {[string first Error $b] != -1} {
1371        # got an error, show it
1372        ShowBigMessage \
1373                 $top.error \
1374                 "Error processing space group\nReview error message below" \
1375                 $b
1376        return
1377    } else {
1378        # show the result and confirm
1379        set opt [ShowBigMessage \
1380                $top.check \
1381                "Check the symmetry operators in the output below" \
1382                $b \
1383                {Continue Redo} ]
1384        if {$opt > 1} return
1385    }
1386    file delete spg.in spg.out
1387    # draw coordinates box
1388    eval destroy [winfo children $top]
1389    grid [label $top.l1 -relief groove -bd 4 -anchor center\
1390            -text "Atom list for phase #$phase"] \
1391            -column 0 -row 0 \
1392            -sticky we -columnspan 10
1393    grid [canvas $top.canvas \
1394            -scrollregion {0 0 5000 500} -width 0 -height 250 \
1395            -yscrollcommand "$top.scroll set"] \
1396            -column 0 -row 2 -columnspan 4 -sticky nsew
1397    grid columnconfigure $top 3 -weight 1
1398    grid rowconfigure $top 2 -weight 1
1399    grid rowconfigure $top 1 -pad 5
1400    scrollbar $top.scroll \
1401            -command "$top.canvas yview"
1402    frame $top.canvas.fr
1403    $top.canvas create window 0 0 -anchor nw -window $top.canvas.fr
1404
1405    set np $top.canvas.fr
1406    set row 0
1407    set col 0
1408    foreach i {Atom\ntype Name x y z Occ Uiso Use} {
1409        grid [label $np.l_${row}$i -text $i] -column [incr col] -row $row
1410    }
1411
1412    # add the old atoms, if appropriate
1413    if {!$expgui(DeleteAllAtoms)} {
1414        # loop over all atoms
1415        foreach atom $expmap(atomlist_$phase) {
1416            set row [MakeAddAtomsRow $top]
1417            # add all atoms in the current phase to the list
1418            foreach w {n x y z t o} var {label x y z type frac} {
1419                $np.e${row}$w delete 0 end
1420                $np.e${row}$w insert end [atominfo $phase $atom $var]
1421            }
1422            $np.e${row}u delete 0 end
1423            if {[atominfo $phase $atom temptype] == "I"} {
1424                $np.e${row}u insert end [atominfo $phase $atom Uiso]
1425            } else {
1426                $np.e${row}u insert end [expr ( \
1427                        [atominfo $phase $atom U11] + \
1428                        [atominfo $phase $atom U22] + \
1429                        [atominfo $phase $atom U33]) / 3.]
1430            }
1431        }
1432    }
1433
1434    # add coordinates that have been read in, if any
1435    foreach item $expgui(coordList) {
1436        set row [MakeAddAtomsRow $top]
1437        foreach val $item w {n x y z t o u} {
1438            if {$val != ""} {
1439                $np.e${row}$w delete 0 end
1440                $np.e${row}$w insert end $val
1441            }
1442        }
1443    }
1444    # a blank spot in the table
1445    MakeAddAtomsRow $top
1446
1447    bind $top <Configure> "SetAddAtomsScroll $top"
1448    grid rowconfigure $top 3 -min 10
1449    grid [button $top.b1 -text "Continue"\
1450            -command "replacephase2 $phase $top [list $spg] [list $cell]"] \
1451            -column 0 -row 5 -sticky w
1452    bind $top <Return> "replacephase2 $phase $top [list $spg] [list $cell]"
1453    grid [button $top.b2 -text Cancel \
1454            -command "destroy $top"] -column 1 -row 5 -sticky w
1455    if {[llength $expgui(importFormatList)] > 0} {
1456        grid [frame $top.fr -bd 4 -relief groove] \
1457                -column 3 -row 5 -columnspan 2 -sticky e
1458        grid [button $top.fr.b3 -text "Import atoms from: " \
1459                -command "ImportAtoms \$expgui(importFormat) $top"] \
1460                -column 0 -row 0 -sticky e
1461        eval tk_optionMenu $top.fr.b4 expgui(importFormat) \
1462                $expgui(importFormatList)
1463        grid $top.fr.b4 -column 1 -row 0 -sticky w
1464        grid rowconfig $top.fr 0 -pad 10
1465        grid columnconfig $top.fr 0 -pad 10
1466        grid columnconfig $top.fr 1 -pad 10
1467    }
1468
1469    grid [button $top.b3 -text  "More atom boxes" \
1470            -command "MakeAddAtomsRow $top"] -column 3 \
1471            -columnspan 2 -row 4 -sticky e
1472   
1473    wm title $top "Replacing phase: Enter atoms"
1474    SetAddAtomsScroll $top
1475
1476    # fix focus...
1477    afterputontop
1478    # grab focus, etc.
1479    putontop $top
1480}
1481
1482proc replacephase2 {phase top spg cell} {
1483    global expgui expmap env
1484    # validate coordinates
1485    set np $top.canvas.fr
1486    set row 0
1487    # loop over the defined rows
1488    set err {}
1489    set atomlist {}
1490    while {![catch {grid info $np.e[incr row]t}]} {
1491        if !{$expgui(UseAtom$row)} continue
1492        # ignore blank entries
1493        set line {}
1494        foreach i {t x y z} {
1495            append line [string trim [$np.e${row}$i get]]
1496        }
1497        if {$line == ""} continue
1498        # validate the input
1499        if {[set type [string trim [$np.e${row}t get]]] == ""} {
1500            append err "  line $row: No atom type specified\n"
1501        }
1502        set name [string trim [$np.e${row}n get]]
1503        if {$name == "(default)"} {set name "/"}
1504        if {$name == ""} {set name "/"}
1505        foreach i {x y z o u} n {x y z Occ Uiso} {
1506            if {[set $i [string trim [$np.e${row}$i get]]] == ""} {
1507                append err "  line $row: No value specified for $n\n"
1508            } elseif {[catch {expr [set $i]}]} {
1509                append err "  line $row: The value for $n is invalid\n"
1510            }
1511        }
1512        lappend atomlist "$type $x $y $z $o $name I $u"
1513    }   
1514    if {$err != ""} {
1515        MyMessageBox -icon warning -message "Note Errors:\n$err" -parent $top
1516        return
1517    }
1518    if {[llength $atomlist] == 0} {
1519        MyMessageBox -icon warning -message "No atoms to load!" -parent $top
1520        return
1521    }
1522
1523    pleasewait "updating phase"
1524    # replace spacegroup and cell
1525    phaseinfo $phase spacegroup set $spg
1526    foreach val $cell var {a b c alpha beta gamma} {
1527        phaseinfo $phase $var set $val
1528    }
1529    # delete all atoms
1530    foreach i $expmap(atomlist_$phase) {
1531        EraseAtom $i $phase
1532    }
1533    incr expgui(changed) 8
1534    # write new atoms from table as input to exptool
1535    set fp [open exptool.in w]
1536    puts $fp "A"
1537    puts $fp $phase
1538    # number of atoms
1539    puts $fp [llength $atomlist]
1540    foreach atomline $atomlist {
1541        puts $fp $atomline
1542    }
1543    close $fp
1544    # needed in UNIX
1545    set env(ATOMDATA) [file join $expgui(gsasdir) data atmdata.dat]
1546    # needed in Windows
1547    set env(GSAS) [file nativename $expgui(gsasdir)]
1548
1549    global tcl_platform
1550    # Save the current exp file
1551    savearchiveexp
1552    # disable the file changed monitor
1553    set expgui(expModifiedLast) 0
1554    set expnam [file root [file tail $expgui(expfile)]]
1555    catch {
1556        if {$tcl_platform(platform) == "windows"} {
1557            exec [file join $expgui(gsasexe) exptool.exe] $expnam \
1558                    < exptool.in >& exptool.out
1559        } else {
1560            exec [file join $expgui(gsasexe) exptool] $expnam \
1561                    < exptool.in >& exptool.out
1562        }
1563    } errmsg
1564    # load the revised exp file
1565    loadexp $expgui(expfile)
1566    set fp [open exptool.out r]
1567    set out [read $fp]
1568    close $fp
1569    if {$errmsg != ""} {
1570        append errmsg "\n" $out
1571    } else {
1572        set errmsg $out
1573    }
1574    donewait 
[321]1575    if {$expgui(showexptool)} {
1576        ShowBigMessage \
1577                $top \
1578                "Please review the result from adding the atom(s)" \
1579                $errmsg
1580    }
[268]1581    file delete exptool.in exptool.out
1582    destroy $top
1583}
1584
Note: See TracBrowser for help on using the repository browser.