source: trunk/addcmds.tcl @ 232

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

# on 2000/07/06 21:31:38, toby did:
use short DOS names for adding histograms in Windows
Tell RAWPLOT users todo same (in RunRawplot?)

  • Property rcs:author set to toby
  • Property rcs:date set to 2000/07/06 21:31:38
  • Property rcs:lines set to +34 -9
  • Property rcs:rev set to 1.8
  • Property rcs:state set to Exp
  • Property svn:keywords set to Author Date Revision Id
File size: 23.3 KB
Line 
1# $Id: addcmds.tcl 232 2009-12-04 23:02:36Z 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" -command RunRawplot] \
227            -column 4 -row 5 -rowspan 2
228   
229    grid columnconfigure $np 3 -weight 1
230   
231    wm title $np "add new histogram"
232
233    if {[string trim $newhist(rawfile)] != {}} {
234        validaterawfile $np $newhist(rawfile)
235    }
236    if {[string trim $newhist(instfile)] != {}} {
237        validateinstfile $np $newhist(instfile)
238    }
239    set newhist(banknum) {}
240    set newhist(setnum) {}
241    #    for {set i 0} {$i<100} {incr i} {set newhist(bank$i) 0}
242    #    for {set i 0} {$i<100} {incr i} {set newhist(set$i) 0}
243
244    # grab focus, etc.
245    putontop $np
246
247    tkwait window $np
248
249    # fix focus...
250    afterputontop
251}
252
253# convert a file to Win-95 direct access
254proc WinCvt {file} {
255    global expgui
256    if ![file exists $file] {
257        tk_dialog .warn "Convert Error" \
258                "File $file does not exist" question 0 "OK"
259        return
260    }
261
262    set tmpname "[file join [file dirname $file] tempfile.xxx]"
263    set oldname "[file rootname $file].org"
264    if [file exists $oldname] {
265        set ans [tk_dialog .warn "OK to overwrite?" \
266                "File [file tail $oldname] exists in [file dirname $oldname]. OK to overwrite?" question 0 \
267                "Yes" "No"]
268        if $ans return
269        catch {file delete $oldname}
270    }
271
272    if [catch {
273        set in [open $file r]
274        # needed to test under UNIX
275        set out [open $tmpname w]
276        fconfigure $out -translation crlf
277        set len [gets $in line]
278        if {$len > 160} {
279            # this is a UNIX file. Hope there are no control characters
280            set i 0
281            set j 79
282            while {$j < $len} {
283                puts $out [string range $line $i $j]
284                incr i 80
285                incr j 80
286            }
287        } else {
288            while {$len >= 0} {
289                append line "                                        "
290                append line "                                        "
291                set line [string range $line 0 79]
292                puts $out $line
293                set len [gets $in line]
294            }
295        }
296        close $in
297        close $out
298        file rename $file $oldname
299        file rename $tmpname $file
300    } errmsg] {
301        tk_dialog .warn Notify "Error in conversion:\n$errmsg" warning 0 OK
302    }
303    return $file
304}
305
306proc getrawfile {np} {
307    global newhist tcl_platform
308    if {$tcl_platform(platform) == "windows"} {
309        set inp [
310        tk_getOpenFile -parent $np -initialfile $newhist(rawfile) -filetypes {
311            {"Data files" .GSAS} {"Data files" .GSA} 
312            {"Data files" .RAW}  {"All files" *}
313        }
314        ]
315    } else {
316        set inp [
317        tk_getOpenFile -parent $np -initialfile $newhist(rawfile) -filetypes {
318            {"Data files" .GSA*} {"Data files" .RAW} 
319            {"Data files" .gsa*} {"Data files" .raw} 
320            {"All files" *}
321        } 
322        ]
323    }
324    validaterawfile $np $inp
325}
326
327proc validaterawfile {np inp} {
328    global tcl_platform expgui newhist
329    if {$inp == ""} return
330    if [catch {set in [open $inp r]}] {
331        tk_dialog .err "Open error" "Unable to open file $inp" \
332                error 0 OK
333        return 
334    }
335    set newhist(banklist) {}
336    foreach child [pack slaves $np.bank] {destroy $child}
337    # is this a properly formatted file?
338    if {$tcl_platform(platform) == "windows"} {
339        # are lines the correct length?
340
341        #--> can we check that lines are terminated CR-LF?
342
343        set i 0
344        while {[set len [gets $in line]] > 0} {
345            incr i
346            if {$len != 80} {
347                set ans [tk_dialog .err "Read error" \
348                        "File $inp is not direct access. OK to convert?" \
349                        error 0 OK QUIT]
350                if {$ans == 0} {
351                    close $in
352                    WinCvt $inp
353                    set i 0
354                    set in [open $inp r]
355                    set line {}
356                } else {
357                    return
358                }
359            }
360            # scan for BANK lines
361            if {[string first BANK $line] == 0} {
362                scan $line "BANK%d" num
363                lappend newhist(banklist) $num
364            }
365            # check for "Instrument parameter file" line
366            if {$i == 2 && [string first "Instrument parameter" $line] == 0} {
367                validateinstfile $np \
368                        [file join [file dirname $inp] \
369                        [string trim [string range $line 26 end]]]
370            }
371        }
372    } else {
373        # is the file one big record?
374        set len [gets $in line]
375        # a instrument parameter file should be more than 4 lines
376        if {$len <= 4*80} {
377            set ans [tk_dialog .err "Read error" \
378                    "File $inp is not direct access. OK to convert?" \
379                    error 0 OK QUIT]
380            if {$ans == 0} {
381                close $in
382                set oldname ${inp}.original
383                file rename $inp $oldname
384                if [catch {
385                    exec [file join $expgui(gsasexe) convstod] < \
386                            $oldname > $inp
387                } errmsg] {
388                    tk_dialog .warn Notify \
389                            "Error in conversion:\n$errmsg" warning 0 OK
390                }
391                set in [open $inp r]
392                set line {}
393            } else {
394                return
395            }
396        }
397        seek $in 0
398        set i 0
399        while {[string length [set line [read $in 80]]] == 80} {
400            incr i
401            # scan for BANK lines
402            if {[string first BANK $line] == 0} {
403                scan $line "BANK%d" num
404                lappend newhist(banklist) $num
405            }
406            # check for "Instrument parameter file" line
407            if {$i == 2 && [string first "Instrument parameter" $line] == 0} {
408                validateinstfile $np \
409                        [file join [file dirname $inp] \
410                        [string trim [string range $line 26 end]]]
411            }
412        }
413    }
414    # were banks found?
415    if {$newhist(banklist) == ""} {
416        tk_dialog .err "Read error" \
417                "File $inp has no BANK lines. This is not a valid GSAS data file." \
418                error 0 OK
419        return
420    }
421    # don't use a full path unless needed
422    if {[pwd] == [file dirname $inp]} {
423        set newhist(rawfile) [file tail $inp]
424    } else {
425        set newhist(rawfile) $inp
426    }
427    foreach i $newhist(banklist) {
428        pack [radiobutton $np.bank.$i -text $i \
429                -variable newhist(banknum) -value $i] -side left
430        # only 1 choice, so set it
431        if {[llength $newhist(banklist)] == 1} {set newhist(banknum) $i}
432    }
433}
434
435proc getinstfile {np} {
436    global newhist tcl_platform
437    if {$tcl_platform(platform) == "windows"} {
438        set inp [
439        tk_getOpenFile -parent $np -initialfile $newhist(instfile) -filetypes {
440            {"Inst files" .INST} {"Inst files" .INS} 
441            {"Inst files" .PRM} {"All files" *}
442        }
443        ]
444    } else {
445        set inp [
446        tk_getOpenFile -parent $np -initialfile $newhist(instfile) -filetypes {
447            {"Inst files" .INS*} {"Inst files" .ins*} 
448            {"Inst files" .PRM}  {"Inst files" .prm} 
449            {"All files" *}
450        }
451        ]
452    }
453    validateinstfile $np $inp
454}
455
456proc validateinstfile {np inp} {
457    global tcl_platform expgui newhist
458    if {$inp == ""} return
459    if [catch {set in [open $inp r]}] {
460        tk_dialog .err "Open error" "Unable to open file $inp" \
461                error 0 OK
462        return 
463    }
464    set newhist(instbanks) {}
465    foreach child [pack slaves $np.set] {destroy $child}
466    # is this a properly formatted file?
467    if {$tcl_platform(platform) == "windows"} {
468        # are lines the correct length?
469
470        #--> can we check that lines are terminated CR-LF?
471
472        while {[set len [gets $in line]] > 0} {
473            if {$len != 80} {
474                set ans [tk_dialog .err "Read error" \
475                        "File $inp is not direct access. OK to convert?" \
476                        error 0 OK QUIT]
477                if {$ans == 0} {
478                    close $in
479                    WinCvt $inp
480                    set in [open $inp r]
481                    set line {}
482                } else {
483                    return
484                }
485            }
486            # scan for the INS   BANK line
487            if {[string first "INS   BANK" $line] == 0} {
488                set newhist(instbanks) \
489                        [string trim [string range $line 12 end]]
490            }
491        }
492    } else {
493        # is the file one big record?
494        set len [gets $in line]
495        if {$len <= 80} {
496            set ans [tk_dialog .err "Read error" \
497                    "File $inp is not direct access. OK to convert?" \
498                    error 0 OK QUIT]
499            if {$ans == 0} {
500                close $in
501                set oldname ${inp}.original
502                file rename $inp $oldname
503                if [catch {
504                    exec [file join $expgui(gsasexe) convstod] < \
505                            $oldname > $inp
506                } errmsg] {
507                    tk_dialog .warn Notify \
508                            "Error in conversion:\n$errmsg" warning 0 OK
509                }
510                set in [open $inp r]
511                set line {}
512            } else {
513                return
514            }
515        }
516        seek $in 0
517        while {[string length [set line [read $in 80]]] == 80} {
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    }
525    # were banks found?
526    if {$newhist(instbanks) == ""} {
527        tk_dialog .err "Read error" \
528                "File $inp has no INS   BANK line. This is not a valid GSAS Instrument Parameter file." \
529                error 0 OK
530        return
531    }
532    # don't use a full path unless needed
533    if {[pwd] == [file dirname $inp]} {
534        set newhist(instfile) [file tail $inp]
535    } else {
536        set newhist(instfile) $inp
537    }
538    for {set i 1} {$i <= $newhist(instbanks)} {incr i} {
539        pack [radiobutton $np.set.$i -text $i \
540                -variable newhist(setnum) -value $i] -side left
541        if {$newhist(instbanks) == 1} {set newhist(setnum) $i}
542    }
543}
544
545proc addhist {np} {
546    global expgui newhist tcl_platform
547    # validate the input
548    set err {}
549    if {[string trim $newhist(rawfile)] == ""} {
550        append err "  No data file specified\n"
551    }
552    if {[string trim $newhist(instfile)] == ""} {
553        append err "  No instrument parameter file specified\n"
554    }
555    if {[string trim $newhist(banknum)] == ""} {
556            append err "  Bank number must be specified\n"
557    } elseif {[catch {expr $newhist(banknum)}]} {
558            append err "  Bank number is not valid\n"
559    }
560    if {[string trim $newhist(setnum)] == ""} {
561        append err "  Parameter set number must be specified\n"
562    } elseif {[catch {expr $newhist(setnum)}]} {
563        append err "  Parameter set number is not valid\n"
564    }
565    if {[string trim $newhist(2tLimit)] == ""} {
566        append err "  2Theta/d-space limit must be specified\n"
567    } elseif {[catch {expr $newhist(2tLimit)}]} {
568        append err "  The 2Theta/d-space limit is not valid\n"
569    }
570    if {[string trim $newhist(LimitMode)] == ""} {
571        append err "  Please choose between either a 2Theta or d-space limit\n"
572    }
573
574    if {$err != ""} {
575        tk_dialog .phaseerr "Add Histogram Error" \
576                "The following error(s) were found in your input:\n$err" \
577                error 0 "OK" 
578        return
579    }
580
581    # ok do it!
582    set fp [open exptool.in w]
583    puts $fp "H"
584    if {$tcl_platform(platform) == "windows"} {
585        puts $fp [file attributes $newhist(rawfile) -shortname]
586        puts $fp [file attributes $newhist(instfile) -shortname]
587    } else {
588        puts $fp $newhist(rawfile)
589        puts $fp $newhist(instfile)
590    }
591    puts $fp $newhist(banknum)
592    puts $fp $newhist(setnum)
593    if {$newhist(LimitMode)} {
594        puts $fp "T"
595    } else {
596        puts $fp "D"
597    }
598    puts $fp "$newhist(2tLimit)"
599    puts $fp "/"
600    puts $fp "X"
601    puts $fp "X"
602    close $fp
603    global tcl_platform
604    # Save the current exp file
605    savearchiveexp
606    # disable the file changed monitor
607    set expgui(expModifiedLast) 0
608    set expnam [file root [file tail $expgui(expfile)]]
609    catch {
610        if {$tcl_platform(platform) == "windows"} {
611            exec [file join $expgui(gsasexe) exptool.exe] $expnam \
612                    < exptool.in >& exptool.out
613        } else {
614            exec [file join $expgui(gsasexe) exptool] $expnam \
615                    < exptool.in >& exptool.out
616        }
617    } errmsg
618    # load the revised exp file
619    loadexp $expgui(expfile)
620    set fp [open exptool.out r]
621    set out [read $fp]
622    close $fp
623    destroy $np
624    if {$errmsg != ""} {
625        append errmsg "\n" $out
626    } else {
627        set errmsg $out
628    }
629    ShowBigMessage \
630                 $np \
631                 "Please review the result from adding the phase" \
632                 $errmsg
633    file delete exptool.in exptool.out
634}
635
636proc RunRawplot {} {
637    global newhist tcl_platform
638    # for Windows put a message on top, in case file names must be shortened
639    if {$tcl_platform(platform) == "windows"} {
640        set f1 {}
641        catch {set f1 [file nativename \
642                    [file attributes $newhist(rawfile) -shortname]]}
643        set f2 {}
644        catch {set f2 [file nativename \
645                [file attributes $newhist(instfile) -shortname]]}
646        if {$f1 != "" || $f2 != ""} {
647            set msg "Note: input to RAWPLOT\n"
648            if {$f1 != ""} {append msg "data file: $f1\n"}
649            if {$f2 != ""} {append msg "instrument file: $f2"}
650            MyMessageBox -icon info -message $msg -parent .
651        }
652    }
653    # start RAWPLOT
654    runGSASwEXP rawplot 1
655}
656
657proc MakeAddAtomsBox {phase} {
658    global expmap
659
660    # is there room for more atoms? Well, we will check this someday
661    if {$phase == ""} return
662    if {[llength $phase] != 1} return
663
664    set top .newatoms
665    catch {destroy $top}
666    toplevel $top
667
668    grid [label $top.l1 -relief groove -bd 4 -anchor center\
669            -text "Adding atoms to phase #$phase"] \
670            -column 0 -row 0 \
671            -sticky we -columnspan 10
672#    grid [label $top.l2 -text "Phase title:"] -column 0 -row 1
673   
674    grid [canvas $top.canvas \
675            -scrollregion {0 0 5000 500} -width 0 -height 250 \
676            -yscrollcommand "$top.scroll set"] \
677            -column 0 -row 2 -columnspan 4 -sticky nsew
678    grid columnconfigure $top 3 -weight 1
679    grid rowconfigure $top 2 -weight 1
680    grid rowconfigure $top 1 -pad 5
681    scrollbar $top.scroll \
682            -command "$top.canvas yview"
683    frame $top.canvas.fr
684    $top.canvas create window 0 0 -anchor nw -window $top.canvas.fr
685
686    set np $top.canvas.fr
687    set row 0
688    set col 0
689    foreach i {Atom\ntype Name x y z Occ Uiso Use} {
690        grid [label $np.l_${row}$i -text $i] -column [incr col] -row $row
691    }
692
693    global expgui
694    set expgui(SetAddAtomsScroll) 0
695    MakeAddAtomsRow $top
696    bind $top <Configure> "SetAddAtomsScroll $top"
697
698    grid rowconfigure .newatoms 3 -min 10
699    grid [button $top.b1 -text "Add Atoms"\
700            -command "addatom $phase $top"] -column 0 -row 4 -sticky w
701    bind $top <Return> "addatom $phase $top"
702    grid [button $top.b2 -text Cancel \
703            -command "destroy $top"] -column 1 -row 4 -sticky w
704
705    grid [button $top.b3 -text  "More atoms" \
706            -command "MakeAddAtomsRow $top"] -column 3 \
707            -columnspan 2 -row 4 -sticky e
708   
709    wm title $top "add new atom"
710
711    # grab focus, etc.
712    putontop $top
713
714    tkwait window $top
715
716    # fix focus...
717    afterputontop
718}
719
720proc MakeAddAtomsRow {top} {
721    set np $top.canvas.fr
722    set col -1
723    set row 1
724    # find an empty row
725    while {![catch {grid info $np.e${row}t}]} {incr row}
726    grid [label $np.e${row}num -text $row] -column [incr col]  -row $row
727    grid [entry $np.e${row}t -width 5] -column [incr col]  -row $row
728    grid [entry $np.e${row}n -width 8] -column [incr col]  -row $row
729    foreach i {x y z o u} {
730        grid [entry $np.e${row}$i -width 9] -column [incr col] -row $row
731    }
732    grid [checkbutton $np.e${row}use -variable expgui(UseAtom$row)] \
733            -column [incr col] -row $row
734    # default occupancy
735    $np.e${row}o delete 0 end
736    $np.e${row}o insert end 1.0
737    # default Uiso
738    $np.e${row}u delete 0 end
739    $np.e${row}u insert end 0.025
740    # default occupancy
741    $np.e${row}n delete 0 end
742    $np.e${row}n insert end (default)
743    # use by default
744    $np.e${row}use select
745
746    SetAddAtomsScroll $top
747}
748
749proc SetAddAtomsScroll {top} {
750    global expgui
751    if $expgui(SetAddAtomsScroll) return
752    # prevent reentrance
753    set expgui(SetAddAtomsScroll) 1
754    update
755    set sizes [grid bbox $top.canvas.fr]
756    $top.canvas config -scrollregion $sizes -width [lindex $sizes 2]
757    # use the scroll for BIG atom lists
758    if {[lindex $sizes 3] > [winfo height $top.canvas]} {
759        grid $top.scroll -sticky ns -column 4 -row 2
760    } else {
761        grid forget $top.scroll 
762    }
763    update
764    set expgui(SetAddAtomsScroll) 0
765}
766
767proc addatom {phase top} {
768    global expgui env
769    set np $top.canvas.fr
770    set row 0
771    # loop over the defined rows
772    set err {}
773    set atomlist {}
774    while {![catch {grid info $np.e[incr row]t}]} {
775        if !{$expgui(UseAtom$row)} continue
776        # ignore blank entries
777        set line {}
778        foreach i {t x y z} {
779            append line [string trim [$np.e${row}$i get]]
780        }
781        if {$line == ""} continue
782        # validate the input
783        if {[set type [string trim [$np.e${row}t get]]] == ""} {
784            append err "  line $row: No atom type specified\n"
785        }
786        set name [string trim [$np.e${row}n get]]
787        if {$name == "(default)"} {set name "/"}
788        if {$name == ""} {set name "/"}
789        foreach i {x y z o u} n {x y z Occ Uiso} {
790            if {[set $i [string trim [$np.e${row}$i get]]] == ""} {
791                append err "  line $row: No value specified for $n\n"
792            } elseif {[catch {expr [set $i]}]} {
793                append err "  line $row: The value for $n is invalid\n"
794            }
795        }
796        lappend atomlist "$type $x $y $z $o $name I $u"
797    }   
798    if {$err != ""} {
799        MyMessageBox -icon warning -message "Note Errors:\n$err" -parent $top
800        return
801    }
802    if {[llength $atomlist] == 0} {
803        MyMessageBox -icon warning -message "No atoms to load!" -parent $top
804        return
805    }
806    # ok add the atoms!
807    set fp [open exptool.in w]
808    puts $fp "A"
809    puts $fp $phase
810    # number of atoms
811    puts $fp [llength $atomlist]
812    foreach atomline $atomlist {
813        puts $fp $atomline
814    }
815    close $fp
816    # needed in UNIX
817    set env(ATOMDATA) [file join $expgui(gsasdir) data atmdata.dat]
818    # needed in Windows
819    set env(GSAS) [file nativename $expgui(gsasdir)]
820
821    global tcl_platform
822    # Save the current exp file
823    savearchiveexp
824    # disable the file changed monitor
825    set expgui(expModifiedLast) 0
826    set expnam [file root [file tail $expgui(expfile)]]
827    catch {
828        if {$tcl_platform(platform) == "windows"} {
829            exec [file join $expgui(gsasexe) exptool.exe] $expnam \
830                    < exptool.in >& exptool.out
831        } else {
832            exec [file join $expgui(gsasexe) exptool] $expnam \
833                    < exptool.in >& exptool.out
834        }
835    } errmsg
836    # load the revised exp file
837    loadexp $expgui(expfile)
838    set fp [open exptool.out r]
839    set out [read $fp]
840    close $fp
841    destroy $top
842    if {$errmsg != ""} {
843        append errmsg "\n" $out
844    } else {
845        set errmsg $out
846    }
847    ShowBigMessage \
848                 $top \
849                 "Please review the result from adding the atom" \
850                 $errmsg
851    file delete exptool.in exptool.out
852}
Note: See TracBrowser for help on using the repository browser.