source: branches/sandbox/Geo_Viewer.tcl @ 1022

Last change on this file since 1022 was 1022, checked in by chlake, 11 years ago

Raised window for geo viewer and added Grab release commands to disagledit

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