source: trunk/addcmds.tcl @ 254

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

# on 2000/08/04 18:26:37, toby did:
new procs: MakeXformAtomsBox?, XformAtomsCoord?, XformAtomsOcc?, XformAtomsU

EraseAtoms?

above used for global atom changes on phase pane

  • Property rcs:author set to toby
  • Property rcs:date set to 2000/08/04 18:26:37
  • Property rcs:lines set to +216 -1
  • Property rcs:rev set to 1.10
  • Property rcs:state set to Exp
  • Property svn:keywords set to Author Date Revision Id
File size: 29.8 KB
Line 
1# $Id: addcmds.tcl 254 2009-12-04 23:02:59Z 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 expmap
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    # now select the new phase
178    SelectOnePhase [lindex $expmap(phaselist) end]   
179}
180
181proc MakeAddHistBox {} {
182    global expmap newhist
183
184    # --> should check here if room for another histogram, but only texture
185    # folks will ever need that
186
187    set np .newhist
188    catch {destroy $np}
189    toplevel $np
190
191    grid [label $np.l0 -text "Adding new histogram"] \
192            -column 0 -row 0 -sticky ew -columnspan 7
193    grid [label $np.l1 -text "Data file:"] -column 0 -row 1 
194    grid [label $np.t1 -textvariable newhist(rawfile) -bd 2 -relief ridge] \
195            -column 1 -row 1 -columnspan 3 -sticky ew
196    grid [button $np.b1 -text "Select File" \
197            -command "getrawfile $np" \
198            ] -column 4 -row 1
199
200    grid [label $np.lbank -text "Select bank" -anchor w] -column 1 -row 2 -sticky w
201    grid [frame $np.bank]  -column 2 -row 2 -columnspan 7 -sticky ew
202
203    grid [label $np.l2 -text "Instrument\nParameter file:"] -column 0 -row 3
204    grid [label $np.t2 -textvariable newhist(instfile) -bd 2 -relief ridge] \
205            -column 1 -row 3 -columnspan 3 -sticky ew
206    grid [button $np.b2 -text "Select File" \
207            -command "getinstfile $np" \
208            ] -column 4 -row 3
209
210    grid [label $np.lset -text "Select set" -anchor w] -column 1 -row 4 -sticky w
211    grid [frame $np.set]  -column 2 -row 4 -columnspan 7 -sticky ew
212
213    grid [label $np.l3 -text "Usable data limit:"] -column 0 -row 5 -rowspan 2 
214    grid [entry $np.e3 -width 12 -textvariable newhist(2tLimit) \
215            ] -column 1 -row 5 -rowspan 2 
216    grid [radiobutton $np.cb3 -text "D-min" -variable newhist(LimitMode) \
217            -value 0] -column 2 -row 5 -sticky w
218    grid [radiobutton $np.cb4 -text "TOF/2-Theta Max" -variable newhist(LimitMode)\
219            -value 1] -column 2 -row 6 -sticky w
220   
221    grid [frame $np.f6] -column 1 -row 7 -columnspan 3
222    grid [button $np.f6.b6a -text Add \
223            -command "addhist $np"] -column 0 -row 0
224    bind $np <Return> "addhist $np"
225    grid [button $np.f6.b6b -text Cancel \
226            -command "destroy $np"] -column 1 -row 0
227
228    grid [button $np.f6a -text "Run\nRAWPLOT" -command RunRawplot] \
229            -column 4 -row 5 -rowspan 2
230   
231    grid columnconfigure $np 3 -weight 1
232   
233    wm title $np "add new histogram"
234
235    if {[string trim $newhist(rawfile)] != {}} {
236        validaterawfile $np $newhist(rawfile)
237    }
238    if {[string trim $newhist(instfile)] != {}} {
239        validateinstfile $np $newhist(instfile)
240    }
241    set newhist(banknum) {}
242    set newhist(setnum) {}
243    #    for {set i 0} {$i<100} {incr i} {set newhist(bank$i) 0}
244    #    for {set i 0} {$i<100} {incr i} {set newhist(set$i) 0}
245
246    # grab focus, etc.
247    putontop $np
248
249    tkwait window $np
250
251    # fix focus...
252    afterputontop
253}
254
255# convert a file to Win-95 direct access
256proc WinCvt {file} {
257    global expgui
258    if ![file exists $file] {
259        tk_dialog .warn "Convert Error" \
260                "File $file does not exist" question 0 "OK"
261        return
262    }
263
264    set tmpname "[file join [file dirname $file] tempfile.xxx]"
265    set oldname "[file rootname $file].org"
266    if [file exists $oldname] {
267        set ans [tk_dialog .warn "OK to overwrite?" \
268                "File [file tail $oldname] exists in [file dirname $oldname]. OK to overwrite?" question 0 \
269                "Yes" "No"]
270        if $ans return
271        catch {file delete $oldname}
272    }
273
274    if [catch {
275        set in [open $file r]
276        # needed to test under UNIX
277        set out [open $tmpname w]
278        fconfigure $out -translation crlf
279        set len [gets $in line]
280        if {$len > 160} {
281            # this is a UNIX file. Hope there are no control characters
282            set i 0
283            set j 79
284            while {$j < $len} {
285                puts $out [string range $line $i $j]
286                incr i 80
287                incr j 80
288            }
289        } else {
290            while {$len >= 0} {
291                append line "                                        "
292                append line "                                        "
293                set line [string range $line 0 79]
294                puts $out $line
295                set len [gets $in line]
296            }
297        }
298        close $in
299        close $out
300        file rename $file $oldname
301        file rename $tmpname $file
302    } errmsg] {
303        tk_dialog .warn Notify "Error in conversion:\n$errmsg" warning 0 OK
304    }
305    return $file
306}
307
308proc getrawfile {np} {
309    global newhist tcl_platform
310    if {$tcl_platform(platform) == "windows"} {
311        set inp [
312        tk_getOpenFile -parent $np -initialfile $newhist(rawfile) -filetypes {
313            {"Data files" .GSAS} {"Data files" .GSA} 
314            {"Data files" .RAW}  {"All files" *}
315        }
316        ]
317    } else {
318        set inp [
319        tk_getOpenFile -parent $np -initialfile $newhist(rawfile) -filetypes {
320            {"Data files" .GSA*} {"Data files" .RAW} 
321            {"Data files" .gsa*} {"Data files" .raw} 
322            {"All files" *}
323        } 
324        ]
325    }
326    validaterawfile $np $inp
327}
328
329proc validaterawfile {np inp} {
330    global tcl_platform expgui newhist
331    if {$inp == ""} return
332    if [catch {set in [open $inp r]}] {
333        tk_dialog .err "Open error" "Unable to open file $inp" \
334                error 0 OK
335        return 
336    }
337    set newhist(banklist) {}
338    foreach child [pack slaves $np.bank] {destroy $child}
339    # is this a properly formatted file?
340    if {$tcl_platform(platform) == "windows"} {
341        # are lines the correct length?
342
343        #--> can we check that lines are terminated CR-LF?
344
345        set i 0
346        while {[set len [gets $in line]] > 0} {
347            incr i
348            if {$len != 80} {
349                set ans [tk_dialog .err "Read error" \
350                        "File $inp is not direct access. OK to convert?" \
351                        error 0 OK QUIT]
352                if {$ans == 0} {
353                    close $in
354                    WinCvt $inp
355                    set i 0
356                    set in [open $inp r]
357                    set line {}
358                } else {
359                    return
360                }
361            }
362            # scan for BANK lines
363            if {[string first BANK $line] == 0} {
364                scan $line "BANK%d" num
365                lappend newhist(banklist) $num
366            }
367            # check for "Instrument parameter file" line
368            if {$i == 2 && [string first "Instrument parameter" $line] == 0} {
369                validateinstfile $np \
370                        [file join [file dirname $inp] \
371                        [string trim [string range $line 26 end]]]
372            }
373        }
374    } else {
375        # is the file one big record?
376        set len [gets $in line]
377        # a instrument parameter file should be more than 4 lines
378        if {$len <= 4*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                set oldname ${inp}.original
385                file rename $inp $oldname
386                if [catch {
387                    exec [file join $expgui(gsasexe) convstod] < \
388                            $oldname > $inp
389                } errmsg] {
390                    tk_dialog .warn Notify \
391                            "Error in conversion:\n$errmsg" warning 0 OK
392                }
393                set in [open $inp r]
394                set line {}
395            } else {
396                return
397            }
398        }
399        seek $in 0
400        set i 0
401        while {[string length [set line [read $in 80]]] == 80} {
402            incr i
403            # scan for BANK lines
404            if {[string first BANK $line] == 0} {
405                scan $line "BANK%d" num
406                lappend newhist(banklist) $num
407            }
408            # check for "Instrument parameter file" line
409            if {$i == 2 && [string first "Instrument parameter" $line] == 0} {
410                validateinstfile $np \
411                        [file join [file dirname $inp] \
412                        [string trim [string range $line 26 end]]]
413            }
414        }
415    }
416    # were banks found?
417    if {$newhist(banklist) == ""} {
418        tk_dialog .err "Read error" \
419                "File $inp has no BANK lines. This is not a valid GSAS data file." \
420                error 0 OK
421        return
422    }
423    # don't use a full path unless needed
424    if {[pwd] == [file dirname $inp]} {
425        set newhist(rawfile) [file tail $inp]
426    } else {
427        set newhist(rawfile) $inp
428    }
429    foreach i $newhist(banklist) {
430        pack [radiobutton $np.bank.$i -text $i \
431                -variable newhist(banknum) -value $i] -side left
432        # only 1 choice, so set it
433        if {[llength $newhist(banklist)] == 1} {set newhist(banknum) $i}
434    }
435}
436
437proc getinstfile {np} {
438    global newhist tcl_platform
439    if {$tcl_platform(platform) == "windows"} {
440        set inp [
441        tk_getOpenFile -parent $np -initialfile $newhist(instfile) -filetypes {
442            {"Inst files" .INST} {"Inst files" .INS} 
443            {"Inst files" .PRM} {"All files" *}
444        }
445        ]
446    } else {
447        set inp [
448        tk_getOpenFile -parent $np -initialfile $newhist(instfile) -filetypes {
449            {"Inst files" .INS*} {"Inst files" .ins*} 
450            {"Inst files" .PRM}  {"Inst files" .prm} 
451            {"All files" *}
452        }
453        ]
454    }
455    validateinstfile $np $inp
456}
457
458proc validateinstfile {np inp} {
459    global tcl_platform expgui newhist
460    if {$inp == ""} return
461    if [catch {set in [open $inp r]}] {
462        tk_dialog .err "Open error" "Unable to open file $inp" \
463                error 0 OK
464        return 
465    }
466    set newhist(instbanks) {}
467    foreach child [pack slaves $np.set] {destroy $child}
468    # is this a properly formatted file?
469    if {$tcl_platform(platform) == "windows"} {
470        # are lines the correct length?
471
472        #--> can we check that lines are terminated CR-LF?
473
474        while {[set len [gets $in line]] > 0} {
475            if {$len != 80} {
476                set ans [tk_dialog .err "Read error" \
477                        "File $inp is not direct access. OK to convert?" \
478                        error 0 OK QUIT]
479                if {$ans == 0} {
480                    close $in
481                    WinCvt $inp
482                    set in [open $inp r]
483                    set line {}
484                } else {
485                    return
486                }
487            }
488            # scan for the INS   BANK line
489            if {[string first "INS   BANK" $line] == 0} {
490                set newhist(instbanks) \
491                        [string trim [string range $line 12 end]]
492            }
493        }
494    } else {
495        # is the file one big record?
496        set len [gets $in line]
497        if {$len <= 80} {
498            set ans [tk_dialog .err "Read error" \
499                    "File $inp is not direct access. OK to convert?" \
500                    error 0 OK QUIT]
501            if {$ans == 0} {
502                close $in
503                set oldname ${inp}.original
504                file rename $inp $oldname
505                if [catch {
506                    exec [file join $expgui(gsasexe) convstod] < \
507                            $oldname > $inp
508                } errmsg] {
509                    tk_dialog .warn Notify \
510                            "Error in conversion:\n$errmsg" warning 0 OK
511                }
512                set in [open $inp r]
513                set line {}
514            } else {
515                return
516            }
517        }
518        seek $in 0
519        while {[string length [set line [read $in 80]]] == 80} {
520            # scan for the INS   BANK line
521            if {[string first "INS   BANK" $line] == 0} {
522                set newhist(instbanks) \
523                        [string trim [string range $line 12 end]]
524            }
525        }
526    }
527    # were banks found?
528    if {$newhist(instbanks) == ""} {
529        tk_dialog .err "Read error" \
530                "File $inp has no INS   BANK line. This is not a valid GSAS Instrument Parameter file." \
531                error 0 OK
532        return
533    }
534    # don't use a full path unless needed
535    if {[pwd] == [file dirname $inp]} {
536        set newhist(instfile) [file tail $inp]
537    } else {
538        set newhist(instfile) $inp
539    }
540    for {set i 1} {$i <= $newhist(instbanks)} {incr i} {
541        pack [radiobutton $np.set.$i -text $i \
542                -variable newhist(setnum) -value $i] -side left
543        if {$newhist(instbanks) == 1} {set newhist(setnum) $i}
544    }
545}
546
547proc addhist {np} {
548    global expgui newhist tcl_platform
549    # validate the input
550    set err {}
551    if {[string trim $newhist(rawfile)] == ""} {
552        append err "  No data file specified\n"
553    }
554    if {[string trim $newhist(instfile)] == ""} {
555        append err "  No instrument parameter file specified\n"
556    }
557    if {[string trim $newhist(banknum)] == ""} {
558            append err "  Bank number must be specified\n"
559    } elseif {[catch {expr $newhist(banknum)}]} {
560            append err "  Bank number is not valid\n"
561    }
562    if {[string trim $newhist(setnum)] == ""} {
563        append err "  Parameter set number must be specified\n"
564    } elseif {[catch {expr $newhist(setnum)}]} {
565        append err "  Parameter set number is not valid\n"
566    }
567    if {[string trim $newhist(2tLimit)] == ""} {
568        append err "  2Theta/d-space limit must be specified\n"
569    } elseif {[catch {expr $newhist(2tLimit)}]} {
570        append err "  The 2Theta/d-space limit is not valid\n"
571    }
572    if {[string trim $newhist(LimitMode)] == ""} {
573        append err "  Please choose between either a 2Theta or d-space limit\n"
574    }
575
576    if {$err != ""} {
577        tk_dialog .phaseerr "Add Histogram Error" \
578                "The following error(s) were found in your input:\n$err" \
579                error 0 "OK" 
580        return
581    }
582
583    # ok do it!
584    set fp [open exptool.in w]
585    puts $fp "H"
586    if {$tcl_platform(platform) == "windows"} {
587        puts $fp [file attributes $newhist(rawfile) -shortname]
588        puts $fp [file attributes $newhist(instfile) -shortname]
589    } else {
590        puts $fp $newhist(rawfile)
591        puts $fp $newhist(instfile)
592    }
593    puts $fp $newhist(banknum)
594    puts $fp $newhist(setnum)
595    if {$newhist(LimitMode)} {
596        puts $fp "T"
597    } else {
598        puts $fp "D"
599    }
600    puts $fp "$newhist(2tLimit)"
601    puts $fp "/"
602    puts $fp "X"
603    puts $fp "X"
604    close $fp
605    global tcl_platform
606    # Save the current exp file
607    savearchiveexp
608    # disable the file changed monitor
609    set expgui(expModifiedLast) 0
610    set expnam [file root [file tail $expgui(expfile)]]
611    catch {
612        if {$tcl_platform(platform) == "windows"} {
613            exec [file join $expgui(gsasexe) exptool.exe] $expnam \
614                    < exptool.in >& exptool.out
615        } else {
616            exec [file join $expgui(gsasexe) exptool] $expnam \
617                    < exptool.in >& exptool.out
618        }
619    } errmsg
620    # load the revised exp file
621    loadexp $expgui(expfile)
622    set fp [open exptool.out r]
623    set out [read $fp]
624    close $fp
625    destroy $np
626    if {$errmsg != ""} {
627        append errmsg "\n" $out
628    } else {
629        set errmsg $out
630    }
631    ShowBigMessage \
632                 $np \
633                 "Please review the result from adding the phase" \
634                 $errmsg
635    file delete exptool.in exptool.out
636}
637
638proc RunRawplot {} {
639    global newhist tcl_platform
640    # for Windows put a message on top, in case file names must be shortened
641    if {$tcl_platform(platform) == "windows"} {
642        set f1 {}
643        catch {set f1 [file nativename \
644                    [file attributes $newhist(rawfile) -shortname]]}
645        set f2 {}
646        catch {set f2 [file nativename \
647                [file attributes $newhist(instfile) -shortname]]}
648        if {$f1 != "" || $f2 != ""} {
649            set msg "Note: input to RAWPLOT\n"
650            if {$f1 != ""} {append msg "data file: $f1\n"}
651            if {$f2 != ""} {append msg "instrument file: $f2"}
652            MyMessageBox -icon info -message $msg -parent .
653        }
654    }
655    # start RAWPLOT
656    runGSASwEXP rawplot 1
657}
658
659proc MakeAddAtomsBox {phase} {
660    global expmap
661
662    # is there room for more atoms? Well, we will check this someday
663    if {$phase == ""} return
664    if {[llength $phase] != 1} return
665
666    set top .newatoms
667    catch {destroy $top}
668    toplevel $top
669
670    grid [label $top.l1 -relief groove -bd 4 -anchor center\
671            -text "Adding atoms to phase #$phase"] \
672            -column 0 -row 0 \
673            -sticky we -columnspan 10
674#    grid [label $top.l2 -text "Phase title:"] -column 0 -row 1
675   
676    grid [canvas $top.canvas \
677            -scrollregion {0 0 5000 500} -width 0 -height 250 \
678            -yscrollcommand "$top.scroll set"] \
679            -column 0 -row 2 -columnspan 4 -sticky nsew
680    grid columnconfigure $top 3 -weight 1
681    grid rowconfigure $top 2 -weight 1
682    grid rowconfigure $top 1 -pad 5
683    scrollbar $top.scroll \
684            -command "$top.canvas yview"
685    frame $top.canvas.fr
686    $top.canvas create window 0 0 -anchor nw -window $top.canvas.fr
687
688    set np $top.canvas.fr
689    set row 0
690    set col 0
691    foreach i {Atom\ntype Name x y z Occ Uiso Use} {
692        grid [label $np.l_${row}$i -text $i] -column [incr col] -row $row
693    }
694
695    global expgui
696    set expgui(SetAddAtomsScroll) 0
697    MakeAddAtomsRow $top
698    bind $top <Configure> "SetAddAtomsScroll $top"
699
700    grid rowconfigure .newatoms 3 -min 10
701    grid [button $top.b1 -text "Add Atoms"\
702            -command "addatom $phase $top"] -column 0 -row 4 -sticky w
703    bind $top <Return> "addatom $phase $top"
704    grid [button $top.b2 -text Cancel \
705            -command "destroy $top"] -column 1 -row 4 -sticky w
706
707    grid [button $top.b3 -text  "More atoms" \
708            -command "MakeAddAtomsRow $top"] -column 3 \
709            -columnspan 2 -row 4 -sticky e
710   
711    wm title $top "add new atom"
712
713    # grab focus, etc.
714    putontop $top
715
716    tkwait window $top
717
718    # fix focus...
719    afterputontop
720}
721
722proc MakeAddAtomsRow {top} {
723    set np $top.canvas.fr
724    set col -1
725    set row 1
726    # find an empty row
727    while {![catch {grid info $np.e${row}t}]} {incr row}
728    grid [label $np.e${row}num -text $row] -column [incr col]  -row $row
729    grid [entry $np.e${row}t -width 5] -column [incr col]  -row $row
730    grid [entry $np.e${row}n -width 8] -column [incr col]  -row $row
731    foreach i {x y z o u} {
732        grid [entry $np.e${row}$i -width 9] -column [incr col] -row $row
733    }
734    grid [checkbutton $np.e${row}use -variable expgui(UseAtom$row)] \
735            -column [incr col] -row $row
736    # default occupancy
737    $np.e${row}o delete 0 end
738    $np.e${row}o insert end 1.0
739    # default Uiso
740    $np.e${row}u delete 0 end
741    $np.e${row}u insert end 0.025
742    # default occupancy
743    $np.e${row}n delete 0 end
744    $np.e${row}n insert end (default)
745    # use by default
746    $np.e${row}use select
747
748    SetAddAtomsScroll $top
749}
750
751proc SetAddAtomsScroll {top} {
752    global expgui
753    if $expgui(SetAddAtomsScroll) return
754    # prevent reentrance
755    set expgui(SetAddAtomsScroll) 1
756    update
757    set sizes [grid bbox $top.canvas.fr]
758    $top.canvas config -scrollregion $sizes -width [lindex $sizes 2]
759    # use the scroll for BIG atom lists
760    if {[lindex $sizes 3] > [winfo height $top.canvas]} {
761        grid $top.scroll -sticky ns -column 4 -row 2
762    } else {
763        grid forget $top.scroll 
764    }
765    update
766    set expgui(SetAddAtomsScroll) 0
767}
768
769proc addatom {phase top} {
770    global expgui env
771    set np $top.canvas.fr
772    set row 0
773    # loop over the defined rows
774    set err {}
775    set atomlist {}
776    while {![catch {grid info $np.e[incr row]t}]} {
777        if !{$expgui(UseAtom$row)} continue
778        # ignore blank entries
779        set line {}
780        foreach i {t x y z} {
781            append line [string trim [$np.e${row}$i get]]
782        }
783        if {$line == ""} continue
784        # validate the input
785        if {[set type [string trim [$np.e${row}t get]]] == ""} {
786            append err "  line $row: No atom type specified\n"
787        }
788        set name [string trim [$np.e${row}n get]]
789        if {$name == "(default)"} {set name "/"}
790        if {$name == ""} {set name "/"}
791        foreach i {x y z o u} n {x y z Occ Uiso} {
792            if {[set $i [string trim [$np.e${row}$i get]]] == ""} {
793                append err "  line $row: No value specified for $n\n"
794            } elseif {[catch {expr [set $i]}]} {
795                append err "  line $row: The value for $n is invalid\n"
796            }
797        }
798        lappend atomlist "$type $x $y $z $o $name I $u"
799    }   
800    if {$err != ""} {
801        MyMessageBox -icon warning -message "Note Errors:\n$err" -parent $top
802        return
803    }
804    if {[llength $atomlist] == 0} {
805        MyMessageBox -icon warning -message "No atoms to load!" -parent $top
806        return
807    }
808    # ok add the atoms!
809    set fp [open exptool.in w]
810    puts $fp "A"
811    puts $fp $phase
812    # number of atoms
813    puts $fp [llength $atomlist]
814    foreach atomline $atomlist {
815        puts $fp $atomline
816    }
817    close $fp
818    # needed in UNIX
819    set env(ATOMDATA) [file join $expgui(gsasdir) data atmdata.dat]
820    # needed in Windows
821    set env(GSAS) [file nativename $expgui(gsasdir)]
822
823    global tcl_platform
824    # Save the current exp file
825    savearchiveexp
826    # disable the file changed monitor
827    set expgui(expModifiedLast) 0
828    set expnam [file root [file tail $expgui(expfile)]]
829    catch {
830        if {$tcl_platform(platform) == "windows"} {
831            exec [file join $expgui(gsasexe) exptool.exe] $expnam \
832                    < exptool.in >& exptool.out
833        } else {
834            exec [file join $expgui(gsasexe) exptool] $expnam \
835                    < exptool.in >& exptool.out
836        }
837    } errmsg
838    # load the revised exp file
839    loadexp $expgui(expfile)
840    set fp [open exptool.out r]
841    set out [read $fp]
842    close $fp
843    destroy $top
844    if {$errmsg != ""} {
845        append errmsg "\n" $out
846    } else {
847        set errmsg $out
848    }
849    ShowBigMessage \
850                 $top \
851                 "Please review the result from adding the atom" \
852                 $errmsg
853    file delete exptool.in exptool.out
854}
855
856#----------------------------------------------
857# commands to modify a group of selected atoms |
858#----------------------------------------------
859
860# make the dialog to choose an action
861proc MakeXformAtomsBox {phase} {
862    global expgui expmap
863    set numberList {}
864    set p $expgui(curPhase)
865    foreach AtomIndex $expgui(selectedatomlist) {
866        # get atom number & phase
867        set tuple [lindex $expmap(atomlistboxcontents) $AtomIndex]
868        lappend numberList [lindex $tuple 0]
869    }
870    if {$numberList == ""} return
871    if {[llength $numberList] > 1} {
872        set suffix s
873        set suffixy "ies"
874    } else {
875        set suffix ""
876        set suffixy "y"
877    }
878    set w .global
879    catch {destroy $w}
880    toplevel $w
881    wm title $w "Edit Atomic Parameter -- phase #$phase"
882    # this needs to track by phase
883    grid [label $w.0 \
884            -text "Modifying atom${suffix} [CompressList $numberList] Phase $phase" \
885            -bg yellow -anchor center] -row 0 -column 0 -columnspan 10 \
886            -sticky nsew
887    grid rowconfigure $w 0 -pad 5
888    grid rowconfigure $w 1 -minsize 2
889
890    grid [TitleFrame $w.1 -bd 6 -relief groove -text "Modify coordinates"] \
891            -row 2 -column 0 -columnspan 10 -sticky news
892    set w1 [$w.1 getframe]
893    set row 0
894    foreach v {x y z} {
895        incr row
896        set col -1
897        grid [label $w1.l$v -text "new $v   =   "] -column [incr col] -row $row
898        foreach o {x y z} {
899            grid [entry $w1.e${v}${o} -width 6] -column [incr col] -row $row
900            $w1.e${v}${o} delete 0 end
901            if {$v == $o} {
902                $w1.e${v}${o} insert end "1.0"
903            } else {
904                $w1.e${v}${o} insert end "0."
905            }
906            grid [label $w1.p${v}${o} -text " $o  +  "] \
907                    -column [incr col] -row $row
908        }
909        grid [entry $w1.e${v} -width 6] -column [incr col] -row $row
910        $w1.e${v} delete 0 end
911        $w1.e${v} insert end "0."
912    }
913    grid [button $w1.do -text "Transform Coordinates" \
914            -command "XformAtomsCoord $phase [list $numberList] $w1" \
915            ] -row [incr row] -column 0 -columnspan 10
916
917    grid rowconfigure $w 3 -minsize 5
918    grid [TitleFrame $w.4 -bd 6 -relief groove -text "Modify occupanc${suffixy}"] \
919            -row 4 -column 0 -columnspan 10 -sticky news
920    set w2 [$w.4 getframe]
921    grid [label $w2.1 -text "Occupancy: "] -row 1 -column 0
922    grid [entry $w2.e -width 10] -column 1 -row 1
923    $w2.e delete 0 end
924    $w2.e insert end 1.0
925    grid columnconfigure $w2 2 -weight 1
926    grid [button $w2.do -text "Set Occupanc${suffixy}" \
927            -command "XformAtomsOcc $phase [list $numberList] $w2" \
928            ] -row 2 -column 0 -columnspan 10
929
930    grid rowconfigure $w 5 -minsize 5
931    grid [TitleFrame $w.6 -bd 6 -relief groove \
932            -text "Modify Displacement Parameter$suffix"] \
933            -row 6 -column 0 -columnspan 10 -sticky news
934    set w2 [$w.6 getframe]
935    grid [label $w2.1 -text "Uiso or Uequiv: "] -row 1 -column 0
936    grid [entry $w2.e -width 10] -column 1 -row 1
937    $w2.e delete 0 end
938    $w2.e insert end 0.025
939    grid columnconfigure $w2 2 -weight 1
940    grid [button $w2.do -text "Set U" \
941            -command "XformAtomsU $phase [list $numberList] $w2" \
942            ] -row 2 -column 0 -columnspan 10
943    grid [frame $w2.f] -row 3 -column 0 -columnspan 10
944    grid [button $w2.f.iso -text "Set Isotropic" \
945            -command "XformAtomsU $phase [list $numberList] iso" \
946            ] -row 0 -column 0
947    grid [button $w2.f.aniso -text "Set Anisotropic" \
948            -command "XformAtomsU $phase [list $numberList] aniso" \
949            ] -row 0 -column 1
950
951    grid rowconfigure $w 5 -minsize 5
952    grid [TitleFrame $w.8 -bd 6 -relief groove \
953            -text "Erase Atom$suffix"] \
954            -row 8 -column 0 -columnspan 10 -sticky news
955    set w2 [$w.8 getframe]
956    grid [button $w2.do -text "Erase Atom${suffix}" \
957            -command "EraseAtoms $phase [list $numberList] $w" \
958            ] -row 2 -column 0 -columnspan 10
959
960
961    grid rowconfigure $w 9 -minsize 5
962    grid [frame $w.b] -row 10 -column 0
963    pack [button $w.b.3 -text Close -command "destroy $w"] -side left
964    bind $w <Return> "destroy $w"
965
966    # force the window to stay on top
967    putontop $w
968    focus $w.b.3
969    tkwait window $w
970    afterputontop
971    # if there are selected atoms, reset their display
972    if {[llength $expgui(selectedatomlist)] != 0} editRecord
973}
974
975# transform the coordinates
976proc XformAtomsCoord {phase numberList w1} {
977    global expgui
978    # get the matrix
979    foreach v {x y z} {
980        foreach o {x y z} {
981            set matrix(${v}${o}) [$w1.e${v}${o} get]
982        }
983        set matrix(${v}) [$w1.e${v} get]
984    }
985    foreach atom $numberList {
986        foreach v {x y z} {
987            set $v [atominfo $phase $atom $v]
988        }
989        foreach v {x y z} {
990            set new$v $matrix(${v})
991            foreach o {x y z} {
992                set new$v [expr [set new$v] + $matrix(${v}${o})*[set $o]]
993            }
994            atominfo $phase $atom $v set [set new$v]
995        }
996        incr expgui(changed)
997    }
998    DisplayAllAtoms noreset
999}
1000
1001# set the occupancies to a single value
1002proc XformAtomsOcc {phase numberList w2} {
1003    global expgui
1004    # get the value
1005    set val [$w2.e get]
1006    foreach atom $numberList {
1007        atominfo $phase $atom frac set $val
1008        incr expgui(changed)
1009    }
1010    DisplayAllAtoms noreset
1011}
1012
1013# transform Uiso or Uij; if anisotropic set Uequiv to Uij
1014proc XformAtomsU {phase numberList w2} {
1015    global expgui
1016    if {$w2 == "iso"} {
1017        foreach atom $numberList {
1018            if {[atominfo $phase $atom temptype] != "I"} {
1019                atominfo $phase $atom temptype set I
1020            }
1021        }
1022    } elseif {$w2 == "aniso"} {
1023        foreach atom $numberList {
1024            if {[atominfo $phase $atom temptype] == "I"} {
1025                atominfo $phase $atom temptype set A
1026            }
1027        }
1028    } else {
1029        # get the value
1030        set val [$w2.e get]
1031        foreach atom $numberList {
1032            if {[atominfo $phase $atom temptype] == "I"} {
1033                atominfo $phase $atom Uiso set $val
1034            } else {
1035                atominfo $phase $atom U11 set $val
1036                atominfo $phase $atom U22 set $val
1037                atominfo $phase $atom U33 set $val
1038                atominfo $phase $atom U12 set 0.0
1039                atominfo $phase $atom U13 set 0.0
1040                atominfo $phase $atom U23 set 0.0
1041            }
1042            incr expgui(changed)
1043        }
1044    }
1045    DisplayAllAtoms noreset
1046}
1047
1048# confirm and erase atoms
1049proc EraseAtoms {phase numberList w2} {
1050    global expgui
1051    if {[llength $numberList] <= 0} return
1052    # make a list of atoms
1053    foreach atom $numberList {
1054        append atomlist "\n\t$atom  [atominfo $phase $atom label]"
1055    }
1056    set msg "OK to remove the following [llength $numberList] atoms from phase $phase:$atomlist"
1057    set val [MyMessageBox -parent $w2 -type okcancel -icon warning \
1058            -default cancel -title "Confirm Erase" -message $msg]
1059    if {$val == "ok"} {
1060        foreach atom $numberList {
1061            EraseAtom $atom $phase
1062            incr expgui(changed)
1063        }
1064        mapexp
1065        DisplayAllAtoms
1066        destroy $w2
1067    }
1068}
1069
Note: See TracBrowser for help on using the repository browser.