source: trunk/Geo_Viewer.tcl @ 1025

Last change on this file since 1025 was 1025, checked in by toby, 10 years ago

see https://subversion.xor.aps.anl.gov/trac/EXPGUI/wiki/News20101013

File size: 13.4 KB
Line 
1#Revision 1 Prints Bond Distances, no ability to sort.
2
3#List of Global Variables:
4#::geo_atomtype($atype1)        contains atom id codes for a particular atom type (atype1)
5#::geo_atomlabel($alabel1)      contains atom id code for a particular atom  (alabel1)
6#::geo_enable($x)               switch to enable bond angle/distance determination.
7#::geo_atomtype                 filtered atom type
8
9#::geo_bond_list   list of bond lengths
10#                  0    phase number
11#                  1    atom 1 code
12#                  2    atom 2 code
13#                  3    atom 1 type
14#                  4    atom 2 type
15#                  5    atom 1 label
16#                  6    atom 2 label
17#                  7    distance
18#                  8    esd
19#                  9    symm code
20#                  10   tranlational symm
21#::geo_angle_list list of bond angles
22#                  0    phase number
23#                  1    atom 1 code (central)
24#                  2    atom 2 code
25#                  3    atom 3 code
26#                  4    atom 1 type (central)
27#                  5    atom 2 type
28#                  6    atom 3 type
29#                  7    atom 1 label (central)
30#                  8    atom 2 label
31#                  9    atom 3 label
32#                  10   angle
33#                  11   esd
34#                  12   symm atom 2
35#                  13   trans atom 2
36#                  14   symm atom 3
37#                  15   trans atom 3
38
39proc Geo_Initialize {} {
40     set ::geo_entryvar(atomtype) "all"
41     catch {unset ::geo_enable}
42     catch {unset ::geo_angles}
43     catch {unset ::geo_bonds}
44     catch {unset ::geo_angle_keys}
45     catch {unset ::geo_phase_list}
46     array set ::geo_angles ""
47     array set ::geo_bonds ""
48     set ::geo_alist ""
49}
50
51proc Geo_Read {filename} {
52
53   if {[file exists $filename]} {
54   set fh [open $filename r]
55   } else {
56     puts "$filename not found in directory [pwd]"
57   }
58
59   set bond_total -1
60   set angle_total -1
61
62   array set ::geo_bonds ""
63   array set ::geo_angles ""
64   array set ::geo_angle_keys ""
65
66   while {[gets $fh line] >= 0} {
67        if {[lindex $line 2] == 0} {
68            incr bond_total
69            set temp $line
70            set t1 ""
71            set phase [lindex $temp 1]
72            set b_dist [lindex $temp 3]
73            set b_esd [lindex $temp 4]
74            set atom1 [lindex $temp 5]
75            set atom2 [lindex $temp 6]
76            set atype1 [atominfo $phase [lindex $temp 5] type]
77            set atype2 [atominfo $phase [lindex $temp 6] type]
78            set atype1 [lindex [split $atype1 {+-}] 0]
79            set atype2 [lindex [split $atype2 {+-}] 0]
80            set alabel1 [atominfo $phase [lindex $temp 5] label]
81            set alabel2 [atominfo $phase [lindex $temp 6] label]
82            set symmcode [string map {" " ""} [set t2 "[lindex $temp 7][lindex $temp 8]"]]
83            set key1 [string map {" " ""} [set t2 "${symmcode}_[lindex $atom2]"]]
84            lappend t1 $phase $atom1 $atom2 $atype1 $atype2 $alabel1 $alabel2 $b_dist $b_esd $symmcode $key1
85            lappend ::geo_bonds($phase,$atom1) $t1
86            lappend ::geo_phase_list $phase
87
88            #create atom lists, remove duplicates
89            lappend ::geo_atomtype${phase}(all) [lindex $temp 5]
90            lappend ::geo_atomtype${phase}($atype1) [lindex $temp 5]
91            set ::geo_atomtype${phase}(all) [lsort -integer -uniq [set ::geo_atomtype${phase}(all)]]
92            set ::geo_atomtype${phase}($atype1) [lsort -integer -uniq [set ::geo_atomtype${phase}($atype1)]]
93
94        } elseif {[lindex $line 2] == 1} {
95            incr angle_total
96            set temp $line
97            set t1 ""
98            set phase [lindex $temp 1]
99            set b_angle [lindex $temp 3]
100            set b_esd [lindex $temp 4]
101            set atom1 [lindex $temp 5]
102            set atom2 [lindex $temp 6]
103            set atom3 [lindex $temp 7]
104            set alabel1 [atominfo $phase [lindex $temp 5] label]
105            set alabel2 [atominfo $phase [lindex $temp 6] label]
106            set alabel3 [atominfo $phase [lindex $temp 7] label]
107            set symmcode1 [string map {" " ""} [set t2 "[lindex $temp 8][lindex $temp 9]"]]
108            set symmcode3 [string map {" " ""} [set t3 "[lindex $temp 10][lindex $temp 11]"]]
109            set key1 [string map {" " ""} [set t2 "${symmcode1}_[lindex $atom1]"]]
110            set key3 [string map {" " ""} [set t3 "${symmcode3}_[lindex $atom3]"]]
111            lappend t1 $phase $atom1 $atom2 $atom3 $alabel1 $alabel2 $alabel3 \
112                         $b_angle $b_esd $key1 $key3
113            lappend ::geo_phase_list $phase
114            set ::geo_angles($phase,$key1,$atom2,$key3) $t1
115        }
116   }
117   set ::geo_phase_list [lsort -integer -uniq $::geo_phase_list]
118   close $fh
119}
120
121proc Geo_Viewer {args} {
122
123    # Run DISAGL
124    global expgui
125    pleasewait "searching interatomic distances"
126    # save EXP file if changed
127    savearchiveexp
128    set root [file root $expgui(expfile)]
129    catch {file delete -force $root.disagl}
130    close [open disagl.inp w]
131    catch {exec [file join $expgui(gsasexe) disagl] \
132               [file tail $root] < disagl.inp > disagl.out}
133    catch {file delete -force disagl.inp disagl.out}
134    if {! [file exists $root.disagl]} {
135        MyMessageBox -parent . -title "DISAGL Problem" \
136            -message "Unable to run DISAGL. Do you have problems writing files in [pwd]?" \
137            -icon error
138        donewait
139        return
140    }
141
142    # load DISAGL distances
143    Geo_Read $root.disagl
144    donewait
145     set mcb .maincontrolbox
146     catch {toplevel $mcb}
147     eval destroy [winfo children $mcb]
148     wm title $mcb "Viewer for Bond Distances and Angles"
149
150     raise $mcb
151     set sc $mcb.sortcon
152     set as $mcb.atomselect
153     set ad $mcb.atomdistlist
154     set dc $mcb.disaglcon
155
156     frame $sc -bd 2 -relief groove
157     frame $as -bd 2 -relief groove
158     frame $ad -bd 2 -relief groove
159     frame $dc -bd 2 -relief groove
160     grid $sc -column 0 -row 0 -sticky new
161     grid $as -column 0 -row 1 -sticky new
162     grid $ad -column 1 -row 0 -rowspan 3 -sticky nesw
163     grid $dc -column 0 -row 2
164
165     grid [button $dc.dcon -text "Run DISAGL Program" -command {DA_Control_Panel 1; unset ::geo_phase_list; Geo_Viewer}] \
166        -column 0 -row 0
167        $dc.dcon config -bd 4
168
169
170     grid rowconfigure $mcb 1 -weight 1
171     grid columnconfigure $mcb 1 -weight 1
172
173     label $sc.phlabel -text Phase
174#     eval tk_optionMenu $sc.phase ::geo_entryvar(phase) $::expmap(phaselist)
175     eval tk_optionMenu $sc.phase ::geo_entryvar(phase) $::geo_phase_list
176     label $sc.atom1 -text "Atom Type"
177     #button $sc.engage -text "Print Info" -command Geo_Fill_Display
178     grid $sc.phlabel -row 0 -column 0
179     grid $sc.phase  -row 0 -column 1
180     grid $sc.atom1 -column 0 -row 1
181
182     label $as.atom -text "Choose Atom(s)"
183
184     grid $as.atom -row 0 -column 1
185
186     foreach {top main side lbl} [MakeScrollTable $as] {}
187     [winfo parent $main] config -bg [$main cget -bg]
188
189   foreach item [trace vinfo ::geo_entryvar(phase)] {
190       eval trace vdelete ::geo_entryvar(phase) $item
191   }
192   foreach item [trace vinfo ::geo_entryvar(atomtype)] {
193       eval trace vdelete ::geo_entryvar(atomtype) $item
194   }
195   set ::geo_entryvar(phase) [lindex $::geo_phase_list 0]
196   Geo_setPhase $sc $as $main
197   trace variable ::geo_entryvar(phase) w "Geo_setPhase $sc $as $main"
198   trace variable ::geo_entryvar(atomtype) w "Geo_setAtomType $sc $as $main"
199   Geo_Display
200       ResizeScrollTable $as
201       $as.can config -width [lindex [$as.can cget -scrollregion] 2]
202
203   }
204
205proc Geo_setPhase {sc as main args} {
206     catch {destroy $sc.atomtype}
207     catch {eval destroy [winfo children $::geo_main]}
208     catch {eval destroy [winfo children $::geo_side]}
209     set ::geo_entryvar(atomtype) all
210     set ::geo_alist ""
211     eval tk_optionMenu $sc.atomtype ::geo_entryvar(atomtype) \
212          "[lsort [array names ::geo_atomtype${::geo_entryvar(phase)}]]"
213     grid $sc.atomtype -column 1 -row 1
214     Geo_setAtomType  $sc $as $main
215}
216
217proc Geo_setAtomType {sc as main args} {
218   set ::geo_atomlist ""
219   set ::geo_atomlist [set ::geo_atomtype${::geo_entryvar(phase)}($::geo_entryvar(atomtype))]
220   set rownum 1
221   set colnum 1
222   eval destroy [winfo children $main]
223      foreach i $::geo_atomlist {
224             #puts $i
225             if {[expr $colnum % 5] == 0} {incr rownum; set colnum 1}
226             set x [atominfo $::geo_entryvar(phase) $i  label]
227             set xlower [string tolower $x]
228             set ::geo_enable($xlower) $i
229             #parray ::geo_enable
230             button $main.atom_$xlower -text "$x" -width 5 -command "Geo_Enable $main.atom_$xlower $::geo_enable($xlower)"
231             grid $main.atom_$xlower -column $colnum -row $rownum -padx 5 -pady 5
232             incr colnum
233
234             }
235      ResizeScrollTable $as
236      $as.can config -width [lindex [$as.can cget -scrollregion] 2]
237}
238
239proc Geo_Enable {main entry args} {
240
241        if {[$main cget -relief] == "raised"} {
242        lappend ::geo_alist $entry
243        $main config -bg green -relief sunken
244
245        } else {
246          set i [lsearch $::geo_alist $entry]
247          puts "seach = $i"
248          set ::geo_alist [string trim [lreplace $::geo_alist $i $i]]
249#          $main config -bg SystemButtonFace -relief raised
250          $main config -bg LightGray -relief raised
251        }
252   Geo_Fill_Display
253}
254
255proc Geo_Display {args} {
256     catch {destroy $as.$main}
257
258     set ad .maincontrolbox.atomdistlist
259     foreach {top ::geo_main ::geo_side lbl} [MakeScrollTable $ad] {}
260     [winfo parent $::geo_main] config -bg [$::geo_main cget -bg]
261
262     bind $ad <Configure> "catch {ResizeScrollTable $ad}"
263       ResizeScrollTable $ad
264       $ad.can config -width 500
265
266
267     #puts "$ad $::geo_main"
268
269 #    label $top.toplabel0 -text "Atom 1" -width 8
270     label $top.toplabel1 -text "Atom 2" -width 8
271     label $top.toplabel2 -text "symm" -width 8
272     label $top.toplabel3 -text "Distance" -width 8
273     label $top.toplabel4 -text "Angle"
274#     grid $top.toplabel0 -column 0 -row 0
275     grid $top.toplabel1 -column 0 -row 0
276     grid $top.toplabel2 -column 1 -row 0
277     grid $top.toplabel3 -column 2 -row 0
278     grid $top.toplabel4 -column 3 -row 0
279}
280proc Geo_Fill_Display {args} {
281     set rownum 0
282     set colnum 3
283     set bondnum 0
284     set counter 0
285     eval destroy [winfo children $::geo_main]
286     eval destroy [winfo children $::geo_side]
287
288     foreach i $::geo_alist {
289             set slist [lsort -index 7 $::geo_bonds($::geo_entryvar(phase),$i)]
290             set colnum 3
291             set keylist ""
292             set atmlist {}
293             set symlist {}
294             incr rownum
295             foreach j $slist {
296                 lappend keylist [lindex $j 10]
297                 lappend atmlist [lindex $j 6]
298                 lappend symlist [lindex $j 9]
299                 label $::geo_side.atom1${bondnum} -text [lindex $j 5] -width 8
300                 label $::geo_main.atom2${bondnum} -text [lindex $j 6] -width 8
301                 label $::geo_main.atom2symm${bondnum} -text [lindex $j 9] -width 8
302                 label $::geo_main.bonddist${bondnum} -text [lindex $j 7] -width 8
303
304                 grid $::geo_side.atom1${bondnum} -row $rownum -column 0
305                 grid $::geo_main.atom2${bondnum} -row $rownum -column 0
306                 grid $::geo_main.atom2symm${bondnum} -row $rownum -column 1
307                 grid $::geo_main.bonddist${bondnum} -row $rownum -column 2
308
309                 set key [lindex $j 10]
310                 set atom [lindex $j 1]
311                 set phase [lindex $j 0]
312
313
314                 foreach k $keylist {
315
316                 if {$key != $k} {
317                    if {[array name ::geo_angles "$phase,$key,$atom,$k"] != ""} {
318                    label $::geo_main.$counter -text [lindex $::geo_angles($phase,$key,$atom,$k) 7]
319                    grid $::geo_main.$counter -row $rownum -column $colnum -padx 5
320                    incr colnum
321                    incr counter
322                    } elseif {[array name ::geo_angles "$phase,$k,$atom,$key"] != ""} {
323                    label $::geo_main.$counter -text [lindex $::geo_angles($phase,$k,$atom,$key) 7]
324                    grid $::geo_main.$counter -row $rownum -column $colnum -padx 5
325
326                    incr colnum
327                    incr counter
328                    }
329
330                 }
331                 }
332                 incr bondnum
333                incr rownum
334                 set colnum 3
335
336             }
337                  set colnum 3
338            incr rownum
339             foreach atm [lrange $atmlist 0 end-1] {
340                label $::geo_main.$counter -text $atm
341                grid $::geo_main.$counter -row $rownum -column $colnum
342                    incr colnum
343                    incr counter
344             }
345                 set colnum 3
346             incr rownum
347             foreach sym [lrange $symlist 0 end-1] {
348                label $::geo_main.$counter -text $sym
349                grid $::geo_main.$counter -row $rownum -column $colnum
350                    incr colnum
351                    incr counter
352             }
353              incr rownum
354             grid rowconfigure $::geo_main $rownum  -minsize 10
355}
356ResizeScrollTable [winfo parent [winfo parent $::geo_main]]
357MouseWheelScrollTable [winfo parent [winfo parent $::geo_main]]
358}
359proc Geo_Print {} {
360}
361
362Geo_Initialize
363#Geo_Read TEST.DISAGL
364#Geo_Viewer
365
Note: See TracBrowser for help on using the repository browser.