source: trunk/addcmds.tcl @ 197

Last change on this file since 197 was 197, checked in by toby, 14 years ago

# on 2000/06/09 03:44:05, toby did:
remove puts debugging commands

  • Property rcs:author set to toby
  • Property rcs:date set to 2000/06/09 03:44:05
  • Property rcs:lines set to +1 -3
  • Property rcs:rev set to 1.7
  • Property rcs:state set to Exp
  • Property svn:keywords set to Author Date Revision Id
File size: 22.5 KB
Line 
1# $Id: addcmds.tcl 197 2009-12-04 23:02:01Z toby $
2
3proc MakeAddPhaseBox {} {
4    global expmap
5
6    set nextphase ""
7    foreach p {1 2 3 4 5 6 7 8 9} {
8        if {[lsearch $expmap(phaselist) $p] == -1} {
9            set nextphase $p
10            break
11        }
12    }
13
14    # no more room
15    if {$nextphase == ""} {
16        tk_dialog .phaseerr "Add Phase Error" \
17                "There are already 9 phases. You cannot add more." \
18                error 0 "OK" 
19        return
20    }
21
22    set np .newphase
23    catch {destroy $np}
24    toplevel $np
25
26    grid [label $np.l1 -text "Adding phase #$nextphase"] \
27            -column 0 -row 0 -sticky w
28    grid [label $np.l2 -text "Phase title:"] -column 0 -row 1 
29    grid [entry $np.t1 -width 68] -column 1 -row 1 -columnspan 8
30    grid [label $np.l3 -text "Space Group:"] -column 0 -row 2 
31    grid [entry $np.t2 -width 12] -column 1 -row 2 
32    grid [frame $np.f -bd 4 -relief groove] -column 3 -row 2 -columnspan 8
33    set col -1
34    foreach i {a b c} {
35        grid [label $np.f.l1$i -text $i] -column [incr col] -row 1
36        grid [entry $np.f.e1$i -width 12] -column [incr col]  -row 1
37    }
38    set col -1
39    foreach i {a b g} {
40        grid [label $np.f.l2$i -text $i -font symbol] -column [incr col] -row 2
41        grid [entry $np.f.e2$i -width 12] -column [incr col]  -row 2
42        $np.f.e2$i insert 0 90.
43    }   
44   
45    grid [button $np.b1 -text Add \
46            -command "addphase $np"] -column 2 -row 3
47    bind $np <Return> "addphase $np"
48    grid [button $np.b2 -text Cancel \
49            -command "destroy $np"] -column 3 -row 3
50   
51    wm title $np "add new phase"
52
53    # grab focus, etc.
54    putontop $np
55
56    tkwait window $np
57
58    # fix focus...
59    afterputontop
60}
61
62proc addphase {np} {
63    global expgui
64    # validate the input
65    set err {}
66    set title [$np.t1 get]
67    if {[string trim $title] == ""} {
68        append err "  Title cannot be blank\n"
69    }
70    set spg [$np.t2 get]
71    if {[string trim $spg] == ""} {
72        append err "  Space group cannot be blank\n"
73    }
74    foreach i {a b c} {
75        set cell($i) [$np.f.e1$i get]
76        if {[string trim $cell($i)] == ""} {
77            append err "  $i cannot be blank\n"
78        } elseif {[catch {expr $cell($i)}]} {
79            append err "  $i is not valid\n"
80        }
81    }
82
83    foreach i {a b g} lbl {alpha beta gamma} {
84        set cell($lbl) [$np.f.e2$i get]
85        if {[string trim $cell($lbl)] == ""} {
86            append err "  $lbl cannot be blank\n"
87        } elseif {[catch {expr $cell($lbl)}]} {
88            append err "  $lbl is not valid\n"
89        }
90    }
91
92    if {$err != ""} {
93        tk_dialog .phaseerr "Add Phase Error" \
94                "The following error(s) were found in your input:\n$err" \
95                error 0 "OK" 
96        return
97    }
98
99    # check the space group
100    set fp [open spg.in w]
101    puts $fp "N"
102    puts $fp "N"
103    puts $fp $spg
104    puts $fp "Q"
105    close $fp
106    global tcl_platform
107    catch {
108        if {$tcl_platform(platform) == "windows"} {
109            exec [file join $expgui(gsasexe) spcgroup.exe] < spg.in >& spg.out
110        } else {
111            exec [file join $expgui(gsasexe) spcgroup] < spg.in >& spg.out
112        }
113    }
114    set fp [open spg.out r]
115    set out [read $fp]
116    close $fp
117    # attempt to parse out the output (fix up if parse did not work)
118    if {[regexp "space group symbol.*>(.*)Enter a new space group symbol" \
119            $out a b ] != 1} {set b $out}
120    if {[string first Error $b] != -1} {
121        # got an error, show it
122        ShowBigMessage \
123                 $np.error \
124                 "Error processing space group\nReview error message below" \
125                 $b
126        return
127    } else {
128        # show the result and confirm
129        set opt [ShowBigMessage \
130                $np.check \
131                "Check the symmetry operators in the output below" \
132                $b \
133                {Continue Redo} ]
134        if {$opt > 1} return
135    }
136    file delete spg.in spg.out
137   
138    # ok do it!
139    set fp [open exptool.in w]
140    puts $fp "P"
141    puts $fp $title
142    puts $fp $spg
143    puts $fp "$cell(a) $cell(b) $cell(c) $cell(alpha) $cell(beta) $cell(gamma)"
144    puts $fp "/"
145    close $fp
146    global tcl_platform
147    # Save the current exp file
148    savearchiveexp
149    # disable the file changed monitor
150    set expgui(expModifiedLast) 0
151    set expnam [file root [file tail $expgui(expfile)]]
152    catch {
153        if {$tcl_platform(platform) == "windows"} {
154            exec [file join $expgui(gsasexe) exptool.exe] $expnam \
155                    < exptool.in >& exptool.out
156        } else {
157            exec [file join $expgui(gsasexe) exptool] $expnam \
158                    < exptool.in >& exptool.out
159        }
160    } errmsg
161    # load the revised exp file
162    loadexp $expgui(expfile)
163    set fp [open exptool.out r]
164    set out [read $fp]
165    close $fp
166    destroy $np
167    if {$errmsg != ""} {
168        append errmsg "\n" $out
169    } else {
170        set errmsg $out
171    }
172    ShowBigMessage \
173                 $np \
174                 "Please review the result from adding the phase" \
175                 $errmsg
176    file delete exptool.in exptool.out
177}
178
179proc MakeAddHistBox {} {
180    global expmap newhist
181
182    # --> should check here if room for another histogram, but only texture
183    # folks will ever need that
184
185    set np .newhist
186    catch {destroy $np}
187    toplevel $np
188
189    grid [label $np.l0 -text "Adding new histogram"] \
190            -column 0 -row 0 -sticky ew -columnspan 7
191    grid [label $np.l1 -text "Data file:"] -column 0 -row 1 
192    grid [label $np.t1 -textvariable newhist(rawfile) -bd 2 -relief ridge] \
193            -column 1 -row 1 -columnspan 3 -sticky ew
194    grid [button $np.b1 -text "Select File" \
195            -command "getrawfile $np" \
196            ] -column 4 -row 1
197
198    grid [label $np.lbank -text "Select bank" -anchor w] -column 1 -row 2 -sticky w
199    grid [frame $np.bank]  -column 2 -row 2 -columnspan 7 -sticky ew
200
201    grid [label $np.l2 -text "Instrument\nParameter file:"] -column 0 -row 3
202    grid [label $np.t2 -textvariable newhist(instfile) -bd 2 -relief ridge] \
203            -column 1 -row 3 -columnspan 3 -sticky ew
204    grid [button $np.b2 -text "Select File" \
205            -command "getinstfile $np" \
206            ] -column 4 -row 3
207
208    grid [label $np.lset -text "Select set" -anchor w] -column 1 -row 4 -sticky w
209    grid [frame $np.set]  -column 2 -row 4 -columnspan 7 -sticky ew
210
211    grid [label $np.l3 -text "Usable data limit:"] -column 0 -row 5 -rowspan 2 
212    grid [entry $np.e3 -width 12 -textvariable newhist(2tLimit) \
213            ] -column 1 -row 5 -rowspan 2 
214    grid [radiobutton $np.cb3 -text "D-min" -variable newhist(LimitMode) \
215            -value 0] -column 2 -row 5 -sticky w
216    grid [radiobutton $np.cb4 -text "TOF/2-Theta Max" -variable newhist(LimitMode)\
217            -value 1] -column 2 -row 6 -sticky w
218   
219    grid [frame $np.f6] -column 1 -row 7 -columnspan 3
220    grid [button $np.f6.b6a -text Add \
221            -command "addhist $np"] -column 0 -row 0
222    bind $np <Return> "addhist $np"
223    grid [button $np.f6.b6b -text Cancel \
224            -command "destroy $np"] -column 1 -row 0
225
226    grid [button $np.f6a -text "Run\nRAWPLOT" \
227            -command "runGSASwEXP rawplot 1" \
228            ] -column 4 -row 5 -rowspan 2
229
230    grid columnconfigure $np 3 -weight 1
231
232    wm title $np "add new histogram"
233
234    if {[string trim $newhist(rawfile)] != {}} {
235        validaterawfile $np $newhist(rawfile)
236    }
237    if {[string trim $newhist(instfile)] != {}} {
238        validateinstfile $np $newhist(instfile)
239    }
240    set newhist(banknum) {}
241    set newhist(setnum) {}
242    #    for {set i 0} {$i<100} {incr i} {set newhist(bank$i) 0}
243    #    for {set i 0} {$i<100} {incr i} {set newhist(set$i) 0}
244
245    # grab focus, etc.
246    putontop $np
247
248    tkwait window $np
249
250    # fix focus...
251    afterputontop
252}
253
254# convert a file to Win-95 direct access
255proc WinCvt {file} {
256    global expgui
257    if ![file exists $file] {
258        tk_dialog .warn "Convert Error" \
259                "File $file does not exist" question 0 "OK"
260        return
261    }
262
263    set tmpname "[file join [file dirname $file] tempfile.xxx]"
264    set oldname "[file rootname $file].org"
265    if [file exists $oldname] {
266        set ans [tk_dialog .warn "OK to overwrite?" \
267                "File [file tail $oldname] exists in [file dirname $oldname]. OK to overwrite?" question 0 \
268                "Yes" "No"]
269        if $ans return
270        catch {file delete $oldname}
271    }
272
273    if [catch {
274        set in [open $file r]
275        # needed to test under UNIX
276        set out [open $tmpname w]
277        fconfigure $out -translation crlf
278        set len [gets $in line]
279        if {$len > 160} {
280            # this is a UNIX file. Hope there are no control characters
281            set i 0
282            set j 79
283            while {$j < $len} {
284                puts $out [string range $line $i $j]
285                incr i 80
286                incr j 80
287            }
288        } else {
289            while {$len >= 0} {
290                append line "                                        "
291                append line "                                        "
292                set line [string range $line 0 79]
293                puts $out $line
294                set len [gets $in line]
295            }
296        }
297        close $in
298        close $out
299        file rename $file $oldname
300        file rename $tmpname $file
301    } errmsg] {
302        tk_dialog .warn Notify "Error in conversion:\n$errmsg" warning 0 OK
303    }
304    return $file
305}
306
307proc getrawfile {np} {
308    global newhist tcl_platform
309    if {$tcl_platform(platform) == "windows"} {
310        set inp [
311        tk_getOpenFile -parent $np -initialfile $newhist(rawfile) -filetypes {
312            {"Data files" .GSAS} {"Data files" .GSA} 
313            {"Data files" .RAW}  {"All files" *}
314        }
315        ]
316    } else {
317        set inp [
318        tk_getOpenFile -parent $np -initialfile $newhist(rawfile) -filetypes {
319            {"Data files" .GSA*} {"Data files" .RAW} 
320            {"Data files" .gsa*} {"Data files" .raw} 
321            {"All files" *}
322        } 
323        ]
324    }
325    validaterawfile $np $inp
326}
327
328proc validaterawfile {np inp} {
329    global tcl_platform expgui newhist
330    if {$inp == ""} return
331    if [catch {set in [open $inp r]}] {
332        tk_dialog .err "Open error" "Unable to open file $inp" \
333                error 0 OK
334        return 
335    }
336    set newhist(banklist) {}
337    foreach child [pack slaves $np.bank] {destroy $child}
338    # is this a properly formatted file?
339    if {$tcl_platform(platform) == "windows"} {
340        # are lines the correct length?
341
342        #--> can we check that lines are terminated CR-LF?
343
344        set i 0
345        while {[set len [gets $in line]] > 0} {
346            incr i
347            if {$len != 80} {
348                set ans [tk_dialog .err "Read error" \
349                        "File $inp is not direct access. OK to convert?" \
350                        error 0 OK QUIT]
351                if {$ans == 0} {
352                    close $in
353                    WinCvt $inp
354                    set i 0
355                    set in [open $inp r]
356                    set line {}
357                } else {
358                    return
359                }
360            }
361            # scan for BANK lines
362            if {[string first BANK $line] == 0} {
363                scan $line "BANK%d" num
364                lappend newhist(banklist) $num
365            }
366            # check for "Instrument parameter file" line
367            if {$i == 2 && [string first "Instrument parameter" $line] == 0} {
368                validateinstfile $np \
369                        [file join [file dirname $inp] \
370                        [string trim [string range $line 26 end]]]
371            }
372        }
373    } else {
374        # is the file one big record?
375        set len [gets $in line]
376        # a instrument parameter file should be more than 4 lines
377        if {$len <= 4*80} {
378            set ans [tk_dialog .err "Read error" \
379                    "File $inp is not direct access. OK to convert?" \
380                    error 0 OK QUIT]
381            if {$ans == 0} {
382                close $in
383                set oldname ${inp}.original
384                file rename $inp $oldname
385                if [catch {
386                    exec [file join $expgui(gsasexe) convstod] < \
387                            $oldname > $inp
388                } errmsg] {
389                    tk_dialog .warn Notify \
390                            "Error in conversion:\n$errmsg" warning 0 OK
391                }
392                set in [open $inp r]
393                set line {}
394            } else {
395                return
396            }
397        }
398        seek $in 0
399        set i 0
400        while {[string length [set line [read $in 80]]] == 80} {
401            incr i
402            # scan for BANK lines
403            if {[string first BANK $line] == 0} {
404                scan $line "BANK%d" num
405                lappend newhist(banklist) $num
406            }
407            # check for "Instrument parameter file" line
408            if {$i == 2 && [string first "Instrument parameter" $line] == 0} {
409                validateinstfile $np \
410                        [file join [file dirname $inp] \
411                        [string trim [string range $line 26 end]]]
412            }
413        }
414    }
415    # were banks found?
416    if {$newhist(banklist) == ""} {
417        tk_dialog .err "Read error" \
418                "File $inp has no BANK lines. This is not a valid GSAS data file." \
419                error 0 OK
420        return
421    }
422    # don't use a full path unless needed
423    if {[pwd] == [file dirname $inp]} {
424        set newhist(rawfile) [file tail $inp]
425    } else {
426        set newhist(rawfile) $inp
427    }
428    foreach i $newhist(banklist) {
429        pack [radiobutton $np.bank.$i -text $i \
430                -variable newhist(banknum) -value $i] -side left
431        # only 1 choice, so set it
432        if {[llength $newhist(banklist)] == 1} {set newhist(banknum) $i}
433    }
434}
435
436proc getinstfile {np} {
437    global newhist tcl_platform
438    if {$tcl_platform(platform) == "windows"} {
439        set inp [
440        tk_getOpenFile -parent $np -initialfile $newhist(instfile) -filetypes {
441            {"Inst files" .INST} {"Inst files" .INS} 
442            {"Inst files" .PRM} {"All files" *}
443        }
444        ]
445    } else {
446        set inp [
447        tk_getOpenFile -parent $np -initialfile $newhist(instfile) -filetypes {
448            {"Inst files" .INS*} {"Inst files" .ins*} 
449            {"Inst files" .PRM}  {"Inst files" .prm} 
450            {"All files" *}
451        }
452        ]
453    }
454    validateinstfile $np $inp
455}
456
457proc validateinstfile {np inp} {
458    global tcl_platform expgui newhist
459    if {$inp == ""} return
460    if [catch {set in [open $inp r]}] {
461        tk_dialog .err "Open error" "Unable to open file $inp" \
462                error 0 OK
463        return 
464    }
465    set newhist(instbanks) {}
466    foreach child [pack slaves $np.set] {destroy $child}
467    # is this a properly formatted file?
468    if {$tcl_platform(platform) == "windows"} {
469        # are lines the correct length?
470
471        #--> can we check that lines are terminated CR-LF?
472
473        while {[set len [gets $in line]] > 0} {
474            if {$len != 80} {
475                set ans [tk_dialog .err "Read error" \
476                        "File $inp is not direct access. OK to convert?" \
477                        error 0 OK QUIT]
478                if {$ans == 0} {
479                    close $in
480                    WinCvt $inp
481                    set in [open $inp r]
482                    set line {}
483                } else {
484                    return
485                }
486            }
487            # scan for the INS   BANK line
488            if {[string first "INS   BANK" $line] == 0} {
489                set newhist(instbanks) \
490                        [string trim [string range $line 12 end]]
491            }
492        }
493    } else {
494        # is the file one big record?
495        set len [gets $in line]
496        if {$len <= 80} {
497            set ans [tk_dialog .err "Read error" \
498                    "File $inp is not direct access. OK to convert?" \
499                    error 0 OK QUIT]
500            if {$ans == 0} {
501                close $in
502                set oldname ${inp}.original
503                file rename $inp $oldname
504                if [catch {
505                    exec [file join $expgui(gsasexe) convstod] < \
506                            $oldname > $inp
507                } errmsg] {
508                    tk_dialog .warn Notify \
509                            "Error in conversion:\n$errmsg" warning 0 OK
510                }
511                set in [open $inp r]
512                set line {}
513            } else {
514                return
515            }
516        }
517        seek $in 0
518        while {[string length [set line [read $in 80]]] == 80} {
519            # scan for the INS   BANK line
520            if {[string first "INS   BANK" $line] == 0} {
521                set newhist(instbanks) \
522                        [string trim [string range $line 12 end]]
523            }
524        }
525    }
526    # were banks found?
527    if {$newhist(instbanks) == ""} {
528        tk_dialog .err "Read error" \
529                "File $inp has no INS   BANK line. This is not a valid GSAS Instrument Parameter file." \
530                error 0 OK
531        return
532    }
533    # don't use a full path unless needed
534    if {[pwd] == [file dirname $inp]} {
535        set newhist(instfile) [file tail $inp]
536    } else {
537        set newhist(instfile) $inp
538    }
539    for {set i 1} {$i <= $newhist(instbanks)} {incr i} {
540        pack [radiobutton $np.set.$i -text $i \
541                -variable newhist(setnum) -value $i] -side left
542        if {$newhist(instbanks) == 1} {set newhist(setnum) $i}
543    }
544}
545
546proc addhist {np} {
547    global expgui newhist
548    # validate the input
549    set err {}
550    if {[string trim $newhist(rawfile)] == ""} {
551        append err "  No data file specified\n"
552    }
553    if {[string trim $newhist(instfile)] == ""} {
554        append err "  No instrument parameter file specified\n"
555    }
556    if {[string trim $newhist(banknum)] == ""} {
557            append err "  Bank number must be specified\n"
558    } elseif {[catch {expr $newhist(banknum)}]} {
559            append err "  Bank number is not valid\n"
560    }
561    if {[string trim $newhist(setnum)] == ""} {
562        append err "  Parameter set number must be specified\n"
563    } elseif {[catch {expr $newhist(setnum)}]} {
564        append err "  Parameter set number is not valid\n"
565    }
566    if {[string trim $newhist(2tLimit)] == ""} {
567        append err "  2Theta/d-space limit must be specified\n"
568    } elseif {[catch {expr $newhist(2tLimit)}]} {
569        append err "  The 2Theta/d-space limit is not valid\n"
570    }
571    if {[string trim $newhist(LimitMode)] == ""} {
572        append err "  Please choose between either a 2Theta or d-space limit\n"
573    }
574
575    if {$err != ""} {
576        tk_dialog .phaseerr "Add Histogram Error" \
577                "The following error(s) were found in your input:\n$err" \
578                error 0 "OK" 
579        return
580    }
581
582    # ok do it!
583    set fp [open exptool.in w]
584    puts $fp "H"
585    puts $fp $newhist(rawfile)
586    puts $fp $newhist(instfile)
587    puts $fp $newhist(banknum)
588    puts $fp $newhist(setnum)
589    if {$newhist(LimitMode)} {
590        puts $fp "T"
591    } else {
592        puts $fp "D"
593    }
594    puts $fp "$newhist(2tLimit)"
595    puts $fp "/"
596    puts $fp "X"
597    puts $fp "X"
598    close $fp
599    global tcl_platform
600    # Save the current exp file
601    savearchiveexp
602    # disable the file changed monitor
603    set expgui(expModifiedLast) 0
604    set expnam [file root [file tail $expgui(expfile)]]
605    catch {
606        if {$tcl_platform(platform) == "windows"} {
607            exec [file join $expgui(gsasexe) exptool.exe] $expnam \
608                    < exptool.in >& exptool.out
609        } else {
610            exec [file join $expgui(gsasexe) exptool] $expnam \
611                    < exptool.in >& exptool.out
612        }
613    } errmsg
614    # load the revised exp file
615    loadexp $expgui(expfile)
616    set fp [open exptool.out r]
617    set out [read $fp]
618    close $fp
619    destroy $np
620    if {$errmsg != ""} {
621        append errmsg "\n" $out
622    } else {
623        set errmsg $out
624    }
625    ShowBigMessage \
626                 $np \
627                 "Please review the result from adding the phase" \
628                 $errmsg
629    file delete exptool.in exptool.out
630}
631
632proc MakeAddAtomsBox {phase} {
633    global expmap
634
635    # is there room for more atoms? Well, we will check this someday
636    if {$phase == ""} return
637    if {[llength $phase] != 1} return
638
639    set top .newatoms
640    catch {destroy $top}
641    toplevel $top
642
643    grid [label $top.l1 -relief groove -bd 4 -anchor center\
644            -text "Adding atoms to phase #$phase"] \
645            -column 0 -row 0 \
646            -sticky we -columnspan 10
647#    grid [label $top.l2 -text "Phase title:"] -column 0 -row 1
648   
649    grid [canvas $top.canvas \
650            -scrollregion {0 0 5000 500} -width 0 -height 250 \
651            -yscrollcommand "$top.scroll set"] \
652            -column 0 -row 2 -columnspan 4 -sticky nsew
653    grid columnconfigure $top 3 -weight 1
654    grid rowconfigure $top 2 -weight 1
655    grid rowconfigure $top 1 -pad 5
656    scrollbar $top.scroll \
657            -command "$top.canvas yview"
658    frame $top.canvas.fr
659    $top.canvas create window 0 0 -anchor nw -window $top.canvas.fr
660
661    set np $top.canvas.fr
662    set row 0
663    set col 0
664    foreach i {Atom\ntype Name x y z Occ Uiso Use} {
665        grid [label $np.l_${row}$i -text $i] -column [incr col] -row $row
666    }
667
668    global expgui
669    set expgui(SetAddAtomsScroll) 0
670    MakeAddAtomsRow $top
671    bind $top <Configure> "SetAddAtomsScroll $top"
672
673    grid rowconfigure .newatoms 3 -min 10
674    grid [button $top.b1 -text "Add Atoms"\
675            -command "addatom $phase $top"] -column 0 -row 4 -sticky w
676    bind $top <Return> "addatom $phase $top"
677    grid [button $top.b2 -text Cancel \
678            -command "destroy $top"] -column 1 -row 4 -sticky w
679
680    grid [button $top.b3 -text  "More atoms" \
681            -command "MakeAddAtomsRow $top"] -column 3 \
682            -columnspan 2 -row 4 -sticky e
683   
684    wm title $top "add new atom"
685
686    # grab focus, etc.
687    putontop $top
688
689    tkwait window $top
690
691    # fix focus...
692    afterputontop
693}
694
695proc MakeAddAtomsRow {top} {
696    set np $top.canvas.fr
697    set col -1
698    set row 1
699    # find an empty row
700    while {![catch {grid info $np.e${row}t}]} {incr row}
701    grid [label $np.e${row}num -text $row] -column [incr col]  -row $row
702    grid [entry $np.e${row}t -width 5] -column [incr col]  -row $row
703    grid [entry $np.e${row}n -width 8] -column [incr col]  -row $row
704    foreach i {x y z o u} {
705        grid [entry $np.e${row}$i -width 9] -column [incr col] -row $row
706    }
707    grid [checkbutton $np.e${row}use -variable expgui(UseAtom$row)] \
708            -column [incr col] -row $row
709    # default occupancy
710    $np.e${row}o delete 0 end
711    $np.e${row}o insert end 1.0
712    # default Uiso
713    $np.e${row}u delete 0 end
714    $np.e${row}u insert end 0.025
715    # default occupancy
716    $np.e${row}n delete 0 end
717    $np.e${row}n insert end (default)
718    # use by default
719    $np.e${row}use select
720
721    SetAddAtomsScroll $top
722}
723
724proc SetAddAtomsScroll {top} {
725    global expgui
726    if $expgui(SetAddAtomsScroll) return
727    # prevent reentrance
728    set expgui(SetAddAtomsScroll) 1
729    update
730    set sizes [grid bbox $top.canvas.fr]
731    $top.canvas config -scrollregion $sizes -width [lindex $sizes 2]
732    # use the scroll for BIG atom lists
733    if {[lindex $sizes 3] > [winfo height $top.canvas]} {
734        grid $top.scroll -sticky ns -column 4 -row 2
735    } else {
736        grid forget $top.scroll 
737    }
738    update
739    set expgui(SetAddAtomsScroll) 0
740}
741
742proc addatom {phase top} {
743    global expgui env
744    set np $top.canvas.fr
745    set row 0
746    # loop over the defined rows
747    set err {}
748    set atomlist {}
749    while {![catch {grid info $np.e[incr row]t}]} {
750        if !{$expgui(UseAtom$row)} continue
751        # ignore blank entries
752        set line {}
753        foreach i {t x y z} {
754            append line [string trim [$np.e${row}$i get]]
755        }
756        if {$line == ""} continue
757        # validate the input
758        if {[set type [string trim [$np.e${row}t get]]] == ""} {
759            append err "  line $row: No atom type specified\n"
760        }
761        set name [string trim [$np.e${row}n get]]
762        if {$name == "(default)"} {set name "/"}
763        if {$name == ""} {set name "/"}
764        foreach i {x y z o u} n {x y z Occ Uiso} {
765            if {[set $i [string trim [$np.e${row}$i get]]] == ""} {
766                append err "  line $row: No value specified for $n\n"
767            } elseif {[catch {expr [set $i]}]} {
768                append err "  line $row: The value for $n is invalid\n"
769            }
770        }
771        lappend atomlist "$type $x $y $z $o $name I $u"
772    }   
773    if {$err != ""} {
774        MyMessageBox -icon warning -message "Note Errors:\n$err" -parent $top
775        return
776    }
777    if {[llength $atomlist] == 0} {
778        MyMessageBox -icon warning -message "No atoms to load!" -parent $top
779        return
780    }
781    # ok add the atoms!
782    set fp [open exptool.in w]
783    puts $fp "A"
784    puts $fp $phase
785    # number of atoms
786    puts $fp [llength $atomlist]
787    foreach atomline $atomlist {
788        puts $fp $atomline
789    }
790    close $fp
791    # needed in UNIX
792    set env(ATOMDATA) [file join $expgui(gsasdir) data atmdata.dat]
793    # needed in Windows
794    set env(GSAS) [file nativename $expgui(gsasdir)]
795
796    global tcl_platform
797    # Save the current exp file
798    savearchiveexp
799    # disable the file changed monitor
800    set expgui(expModifiedLast) 0
801    set expnam [file root [file tail $expgui(expfile)]]
802    catch {
803        if {$tcl_platform(platform) == "windows"} {
804            exec [file join $expgui(gsasexe) exptool.exe] $expnam \
805                    < exptool.in >& exptool.out
806        } else {
807            exec [file join $expgui(gsasexe) exptool] $expnam \
808                    < exptool.in >& exptool.out
809        }
810    } errmsg
811    # load the revised exp file
812    loadexp $expgui(expfile)
813    set fp [open exptool.out r]
814    set out [read $fp]
815    close $fp
816    destroy $top
817    if {$errmsg != ""} {
818        append errmsg "\n" $out
819    } else {
820        set errmsg $out
821    }
822    ShowBigMessage \
823                 $top \
824                 "Please review the result from adding the atom" \
825                 $errmsg
826    file delete exptool.in exptool.out
827}
Note: See TracBrowser for help on using the repository browser.