source: trunk/addcmds.tcl @ 354

Last change on this file since 354 was 354, checked in by toby, 13 years ago

# on 2000/11/27 21:05:56, toby did:
line up >10 banks in Hist add
set 2theta max from Bank header

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