source: branches/sandbox/Geo_Viewer.tcl @ 1021

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

add disagl edit & viewer

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     set sc $mcb.sortcon
176     set as $mcb.atomselect
177     set ad $mcb.atomdistlist
178     set dc $mcb.disaglcon
179
180     frame $sc -bd 2 -relief groove
181     frame $as -bd 2 -relief groove
182     frame $ad -bd 2 -relief groove
183     frame $dc -bd 2 -relief groove
184     grid $sc -column 0 -row 0 -sticky new
185     grid $as -column 0 -row 1 -sticky new
186     grid $ad -column 1 -row 0 -rowspan 3 -sticky nesw
187     grid $dc -column 0 -row 2
188
189     grid [button $dc.dcon -text "Run DISAGL Program" -command {DA_Control_Panel 1; unset ::geo_phase_list; Geo_Viewer}] \
190        -column 0 -row 0
191        $dc.dcon config -bd 4
192
193
194     grid rowconfigure $mcb 1 -weight 1
195     grid columnconfigure $mcb 1 -weight 1
196
197     label $sc.phlabel -text Phase
198#     eval tk_optionMenu $sc.phase ::geo_entryvar(phase) $::expmap(phaselist)
199     eval tk_optionMenu $sc.phase ::geo_entryvar(phase) $::geo_phase_list
200     label $sc.atom1 -text "Atom Type"
201     #button $sc.engage -text "Print Info" -command Geo_Fill_Display
202     grid $sc.phlabel -row 0 -column 0
203     grid $sc.phase  -row 0 -column 1
204     grid $sc.atom1 -column 0 -row 1
205
206     #grid $sc.engage -column 0 -row 2 -columnspan 2
207
208     label $as.atom -text "Choose Atom(s)"
209
210     grid $as.atom -row 0 -column 1
211
212#     label $ad.label -text "Distance and Angle List"
213#     grid $ad.label -row 0 -column 0
214
215
216     foreach {top main side lbl} [MakeScrollTable $as] {}
217     [winfo parent $main] config -bg [$main cget -bg]
218
219   foreach item [trace vinfo ::geo_entryvar(phase)] {
220       eval trace vdelete ::geo_entryvar(phase) $item
221   }
222   foreach item [trace vinfo ::geo_entryvar(atomtype)] {
223       eval trace vdelete ::geo_entryvar(atomtype) $item
224   }
225   set ::geo_entryvar(phase) [lindex $::geo_phase_list 0]
226   Geo_setPhase $sc $as $main
227   trace variable ::geo_entryvar(phase) w "Geo_setPhase $sc $as $main"
228   trace variable ::geo_entryvar(atomtype) w "Geo_setAtomType $sc $as $main"
229   Geo_Display
230       ResizeScrollTable $as
231       $as.can config -width [lindex [$as.can cget -scrollregion] 2]
232
233   #bind $as <Configure> "catch {ResizeScrollTable $as}"
234   #bind $ad <Configure> "catch {ResizeScrollTable $ad}"
235   }
236
237proc Geo_setPhase {sc as main args} {
238     catch {destroy $sc.atomtype}
239     catch {eval destroy [winfo children $::geo_main]}
240     catch {eval destroy [winfo children $::geo_side]}
241     set ::geo_entryvar(atomtype) all
242     set ::geo_alist ""
243     eval tk_optionMenu $sc.atomtype ::geo_entryvar(atomtype) \
244          "[lsort [array names ::geo_atomtype${::geo_entryvar(phase)}]]"
245     grid $sc.atomtype -column 1 -row 1
246     Geo_setAtomType  $sc $as $main
247}
248
249proc Geo_setAtomType {sc as main args} {
250   set ::geo_atomlist ""
251   set ::geo_atomlist [set ::geo_atomtype${::geo_entryvar(phase)}($::geo_entryvar(atomtype))]
252   set rownum 1
253   set colnum 1
254   eval destroy [winfo children $main]
255      foreach i $::geo_atomlist {
256             #puts $i
257             if {[expr $colnum % 5] == 0} {incr rownum; set colnum 1}
258             set x [atominfo $::geo_entryvar(phase) $i  label]
259             set xlower [string tolower $x]
260             set ::geo_enable($xlower) $i
261             #parray ::geo_enable
262             button $main.atom_$xlower -text "$x" -width 5 -command "Geo_Enable $main.atom_$xlower $::geo_enable($xlower)"
263             grid $main.atom_$xlower -column $colnum -row $rownum -padx 5 -pady 5
264             incr colnum
265
266             }
267      ResizeScrollTable $as
268      $as.can config -width [lindex [$as.can cget -scrollregion] 2]
269}
270
271proc Geo_Enable {main entry args} {
272
273        if {[$main cget -relief] == "raised"} {
274        lappend ::geo_alist $entry
275        $main config -bg green -relief sunken
276
277        } else {
278          set i [lsearch $::geo_alist $entry]
279          puts "seach = $i"
280          set ::geo_alist [string trim [lreplace $::geo_alist $i $i]]
281#          $main config -bg SystemButtonFace -relief raised
282          $main config -bg LightGray -relief raised
283        }
284   Geo_Fill_Display
285}
286
287proc Geo_Display {args} {
288     catch {destroy $as.$main}
289
290     set ad .maincontrolbox.atomdistlist
291     foreach {top ::geo_main ::geo_side lbl} [MakeScrollTable $ad] {}
292     [winfo parent $::geo_main] config -bg [$::geo_main cget -bg]
293
294     bind $ad <Configure> "catch {ResizeScrollTable $ad}"
295       ResizeScrollTable $ad
296       $ad.can config -width 500
297
298
299     #puts "$ad $::geo_main"
300
301 #    label $top.toplabel0 -text "Atom 1" -width 8
302     label $top.toplabel1 -text "Atom 2" -width 8
303     label $top.toplabel2 -text "symm" -width 8
304     label $top.toplabel3 -text "Distance" -width 8
305     label $top.toplabel4 -text "Angle"
306#     grid $top.toplabel0 -column 0 -row 0
307     grid $top.toplabel1 -column 0 -row 0
308     grid $top.toplabel2 -column 1 -row 0
309     grid $top.toplabel3 -column 2 -row 0
310     grid $top.toplabel4 -column 3 -row 0
311}
312proc Geo_Fill_Display {args} {
313     set rownum 0
314     set colnum 3
315     set bondnum 0
316     set counter 0
317     eval destroy [winfo children $::geo_main]
318     eval destroy [winfo children $::geo_side]
319
320     foreach i $::geo_alist {
321             set slist [lsort -index 7 $::geo_bonds($::geo_entryvar(phase),$i)]
322             set colnum 3
323             set keylist ""
324             set atmlist {}
325             set symlist {}
326             incr rownum
327             foreach j $slist {
328                 lappend keylist [lindex $j 10]
329                 lappend atmlist [lindex $j 6]
330                 lappend symlist [lindex $j 9]
331                 label $::geo_side.atom1${bondnum} -text [lindex $j 5] -width 8
332                 label $::geo_main.atom2${bondnum} -text [lindex $j 6] -width 8
333                 label $::geo_main.atom2symm${bondnum} -text [lindex $j 9] -width 8
334                 label $::geo_main.bonddist${bondnum} -text [lindex $j 7] -width 8
335
336                 grid $::geo_side.atom1${bondnum} -row $rownum -column 0
337                 grid $::geo_main.atom2${bondnum} -row $rownum -column 0
338                 grid $::geo_main.atom2symm${bondnum} -row $rownum -column 1
339                 grid $::geo_main.bonddist${bondnum} -row $rownum -column 2
340
341                 set key [lindex $j 10]
342                 set atom [lindex $j 1]
343                 set phase [lindex $j 0]
344
345
346                 foreach k $keylist {
347
348                 if {$key != $k} {
349                    if {[array name ::geo_angles "$phase,$key,$atom,$k"] != ""} {
350                    label $::geo_main.$counter -text [lindex $::geo_angles($phase,$key,$atom,$k) 7]
351                    grid $::geo_main.$counter -row $rownum -column $colnum -padx 5
352                    incr colnum
353                    incr counter
354                    } elseif {[array name ::geo_angles "$phase,$k,$atom,$key"] != ""} {
355                    label $::geo_main.$counter -text [lindex $::geo_angles($phase,$k,$atom,$key) 7]
356                    grid $::geo_main.$counter -row $rownum -column $colnum -padx 5
357                    incr colnum
358                    incr counter
359                    }
360
361                 }
362                 }
363                 incr bondnum
364                incr rownum
365                 set colnum 3
366
367             }
368                  set colnum 3
369            incr rownum
370             foreach atm [lrange $atmlist 0 end-1] {
371                label $::geo_main.$counter -text $atm
372                grid $::geo_main.$counter -row $rownum -column $colnum
373                    incr colnum
374                    incr counter
375             }
376                 set colnum 3
377             incr rownum
378             foreach sym [lrange $symlist 0 end-1] {
379                label $::geo_main.$counter -text $sym
380                grid $::geo_main.$counter -row $rownum -column $colnum
381                    incr colnum
382                    incr counter
383             }
384              incr rownum
385             grid rowconfigure $::geo_main $rownum  -minsize 10
386}
387ResizeScrollTable [winfo parent [winfo parent $::geo_main]]
388}
389proc Geo_Print {} {
390}
391
392Geo_Initialize
393#Geo_Read TEST.DISAGL
394#Geo_Viewer
395
Note: See TracBrowser for help on using the repository browser.