source: trunk/export_drawxtl.tcl @ 807

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

# on 2004/09/21 23:14:14, toby did:
Export coordinates directly to DRAWXTL 4.0

  • Property rcs:author set to toby
  • Property rcs:date set to 2004/09/21 23:14:14
  • Property rcs:rev set to 1.1
  • Property rcs:state set to Exp
  • Property svn:keywords set to Author Date Revision Id
File size: 10.6 KB
Line 
1# export a phase to DRAWXTL
2#
3# $Id: export_drawxtl.tcl 807 2009-12-04 23:12:23Z toby $
4# set local variables that define the proc to execute and the menu label
5set label "export to DRAWXTL (.str) file"
6set action export_drawxtl
7proc export_drawxtl {} {
8    global expmap expgui
9    # don't bother if there are no phases to write
10    if {[llength $expmap(phaselist)] == 0} {
11        MyMessageBox -parent . -title "No phases" \
12                -message "Sorry, no phases are present to write" \
13                -icon warning
14        return
15    }
16    foreach t [trace vinfo expgui(export_phase)] {
17        eval trace vdelete expgui(export_phase) $t
18    }
19     MakeExportBox .export "Export coordinates to program DRAWXTL" ""
20#           "MakeWWWHelp expgui.html export"
21
22    # force the window to stay on top
23    putontop .export
24    set bx .export.special
25    global DXTL
26    set DXTL(bonds) 0
27    set row 1
28    grid [label $bx.1 -text "Title:"] -column 1 -row $row -sticky e
29    grid [entry $bx.2 -textvariable DXTL(title) -width 40] \
30        -row $row -column 2 -columnspan 5 -sticky w
31    set DXTL(title) [expinfo title]
32    incr row
33    set DXTL(coords) 1
34    grid [checkbutton $bx.3 -text "Include coordinates in .str file" \
35              -variable DXTL(coords)] \
36        -row $row -column 1 -columnspan 5 -sticky w
37    incr row
38    grid [frame $bx.c -relief groove -bd 4] -row $row -column 0 -columnspan 5
39    grid [label $bx.c.0 -text "Range of fractional coordinates to include" \
40              -anchor center] -row 0 -column 0 -columnspan 8
41    foreach v {x y z} V {X Y Z} {
42        incr row
43        grid [label $bx.c.${v}1 -text "${V} min:"] -column 1 -row $row
44        grid [entry $bx.c.${v}2 -textvariable DXTL(${v}min) -width 4] -column 2 -row $row
45        grid [scale $bx.c.${v}3 -resolution 0.1 -variable DXTL(${v}min) \
46                  -showvalue 0 -orient h -from -2 -to 1] -column 3 -row $row
47        set DXTL(${v}min) -0.1
48        grid [label $bx.c.${v}4 -text " max:"] -column 4 -row $row
49        grid [entry $bx.c.${v}5 -textvariable DXTL(${v}max) -width 4] -column 5 -row $row
50        grid [scale $bx.c.${v}6 -resolution 0.1 -variable DXTL(${v}max) \
51                  -showvalue 0 -orient h -from 0 -to 3] -column 6 -row $row
52        set DXTL(${v}max) 1.1
53    }
54    # atom type box
55    grid [frame $bx.s -relief groove -bd 4] -row $row -column 0 -columnspan 5 -sticky ew
56    grid [label $bx.s.0 -text "Atom representation" \
57              -anchor w] -row 0 -column 0 -sticky w
58    grid [canvas $bx.s.canvas -relief sunk -bd 2 \
59              -scrollregion {0 0 5000 500} -width 250 -height 70 \
60              -yscrollcommand "$bx.s.scroll set" ] \
61        -column 0 -row [incr row] -sticky nsew
62    grid columnconfig $bx.s 0 -weight 1
63    frame [set DXTL(lb) $bx.s.canvas.fr]
64    $bx.s.canvas create window 0 0 -anchor nw -window $DXTL(lb)
65    grid [scrollbar $bx.s.scroll \
66              -command "$bx.s.canvas yview"] -sticky ns -row $row -column 1
67    # bond box
68    incr row
69    grid [frame $bx.b -relief groove -bd 4] -row $row -column 0 -columnspan 5 -sticky ew
70    grid [frame $bx.b.0] -row 0 -column 0 -columnspan 7 -sticky ew
71    grid [label $bx.b.0.1 -text "Bond List" \
72              -anchor w] -row 0 -column 0 -sticky w
73    grid columnconfig $bx.b.0 0 -weight 1
74    grid [button $bx.b.0.b -text "Add Bond" -command DXTLaddBond \
75             ] -row 0 -column 1 -sticky e
76    grid [canvas $bx.b.canvas -relief sunk -bd 2 \
77              -scrollregion {0 0 5000 500} -width 250 -height 70 \
78              -yscrollcommand "$bx.b.scroll set" ] \
79        -column 0 -row [incr row] -sticky nsew
80    grid columnconfig $bx.b 0 -weight 1
81    frame [set DXTL(Blst) $bx.b.canvas.fr]
82    $bx.b.canvas create window 0 0 -anchor nw -window $DXTL(Blst)
83    grid [scrollbar $bx.b.scroll \
84              -command "$bx.b.canvas yview"] -sticky ns -row $row -column 1
85
86    trace variable expgui(export_phase) w SetDXTLatoms
87    SetDXTLatoms
88    # this appears to be needed by OSX
89    ResizeWin .export
90
91    # Wait for the Write or Quit button to be pressed
92    tkwait window .export
93    afterputontop
94    # test for Quit
95    if {$expgui(export_phase) == 0} {return}
96
97    # now open the file and write it
98    set phase $expgui(export_phase)
99    if [catch {
100        set filnam [file rootname $expgui(expfile)]_${phase}.str
101        set fp [open $filnam w]
102        # deal with macromolecular phases
103        if {[lindex $expmap(phasetype) [expr {$phase - 1}]] == 4} {
104            MyMessageBox -parent . -title "MM phase" \
105                -message "Sorry, macromolecular phases cannot be processed" \
106                -icon warning
107            return
108        }
109        catch {unset typelist}
110        foreach atom $expmap(atomlist_$phase) {
111            set typelist([atominfo $phase $atom type]) 1
112        }
113        # title info from GSAS title & phase title
114        puts $fp "REM  created by EXPGUI from $expgui(expfile) on [clock format [clock seconds]]"
115        puts $fp "title \"$DXTL(title)\""
116        puts $fp "pack $DXTL(xmin) $DXTL(xmax) $DXTL(ymin) $DXTL(ymax) $DXTL(zmin) $DXTL(zmax)"
117        puts $fp "edges 0.02 Black"
118        puts $fp "phong 1.0 30."
119        foreach type [array names typelist] {
120            if {$DXTL(display_$type) == "sphere"} {
121                puts $fp "sphere $type $DXTL(radius_$type) $DXTL(color_$type)"
122            } elseif {$DXTL(display_$type) == "polyhedron"} {
123                puts $fp "polysz $type $DXTL(radius_$type) $DXTL(color_$type)"
124            } elseif {$DXTL(display_$type) == "ellipsoid"} {
125                puts $fp "ellipcolor $type * $DXTL(color_$type)"
126            }
127        }
128        if {$DXTL(coords)} {
129            # write out cell parameters
130            puts -nonewline $fp "cell"
131            foreach p {a b c alpha beta gamma} {
132                puts -nonewline $fp " [phaseinfo $phase $p]"
133            }
134            puts $fp ""
135            # write out GSAS spacegroup
136            puts $fp "spgp [phaseinfo $phase spacegroup]"
137            # now loop over atoms
138            foreach atom $expmap(atomlist_$phase) {
139                puts -nonewline $fp "atom [atominfo $phase $atom type] $atom "
140                foreach v {x y z} {
141                    puts -nonewline $fp "[atominfo $phase $atom $v] "
142                }
143                puts $fp ""
144               
145                set uiso [atominfo $phase $atom Uiso]
146                # are there anisotropic atoms? If so convert them to Uequiv
147                if {[atominfo $phase $atom temptype] == "A"} {
148                    puts -nonewline $fp "Uij [atominfo $phase $atom type] $atom "
149                    foreach v {U11 U22 U33 U12 U13 U23} {
150                        puts -nonewline $fp "[atominfo $phase $atom $v] "
151                    }
152                    puts $fp ""
153                }
154            }
155        } else {
156            puts $fp "import gsas [file tail $expgui(expfile)] $phase"
157        }
158        for {set i 1} {$i <= $DXTL(bonds)} {incr i} {
159            puts $fp "bond $DXTL(ba_$i) $DXTL(bb_$i) $DXTL(bw_$i) $DXTL(bmin_$i) $DXTL(bmax_$i) $DXTL(bc_$i)"
160        }
161        puts $fp "END"
162        close $fp
163    } errmsg] {
164        MyMessageBox -parent . -title "Export error" \
165                -message "Export error: $errmsg" -icon warning
166    } else {
167        MyMessageBox -parent . -title "Done" \
168                -message "File [file tail $filnam] was written"
169    }
170    catch {unset DXTL}
171    foreach t [trace vinfo expgui(export_phase)] {
172        eval trace vdelete expgui(export_phase) $t
173    }
174 }
175
176# resize windows -- this appears to be needed by OSX 10.2
177proc ResizeWin {win} {
178    update
179    wm geom $win [winfo reqwidth $win]x[winfo reqheight $win]
180    # center the EXPGUI window
181    wm withdraw $win
182    set x [expr [winfo screenwidth $win]/2 - [winfo reqwidth $win]/2 ]
183    set y [expr [winfo screenheight $win]/2 - [winfo reqheight $win]/2]
184    wm geom $win +$x+$y
185    wm deiconify $win
186}
187
188
189# add atoms to atom representation list
190proc SetDXTLatoms {args} {
191    global DXTL expgui expmap
192    set colorlist "White Red Green Blue Yellow Cyan Magenta Black Orange Brown Grey Silver White"
193    eval destroy [winfo children $DXTL(lb)]
194    eval destroy [winfo children $DXTL(Blst)]
195    set DXTL(bonds) 0
196    if {$expgui(export_phase) == 0} {return}
197    set phase $expgui(export_phase)
198    if {[lindex $expmap(phasetype) [expr {$phase - 1}]] == 4} {
199        MyMessageBox -parent . -title "MM phase" \
200            -message "Sorry, macromolecular phases cannot be processed" \
201            -icon warning
202        return
203    }
204    catch {unset typelist}
205    set DXTL(title)  [phaseinfo $phase name]
206    foreach atom $expmap(atomlist_$phase) {
207        set typelist([atominfo $phase $atom type]) 1
208    }
209    set DXTL(typelist) [array names typelist]
210    set row 0
211    grid [label $DXTL(lb).l$row -text "type " -bg yellow\
212             ] -column 0 -row $row  -sticky ew
213    grid [label $DXTL(lb).d$row -text " representation " -bg yellow
214         ] -column 1 -row $row -sticky ew
215    grid [label $DXTL(lb).e$row -text " radius " -bg yellow\
216             ] -column 2 -row $row -sticky ew
217    grid [label $DXTL(lb).c$row -text " color " -bg yellow\
218             ] -column 3 -row $row -sticky ew
219    foreach type [array names typelist] {
220        incr row
221        grid [label $DXTL(lb).l$row -text $type] -column 0 -row $row
222        tk_optionMenu $DXTL(lb).d$row DXTL(display_$type) sphere polyhedron ellipsoid none
223        grid $DXTL(lb).d$row -column 1 -row $row
224        grid [entry $DXTL(lb).e$row -textvariable DXTL(radius_$type) \
225                -width 5] -column 2 -row $row
226        eval tk_optionMenu $DXTL(lb).c$row DXTL(color_$type) $colorlist
227        grid $DXTL(lb).c$row -column 3 -row $row
228        set DXTL(display_$type) sphere
229        set DXTL(radius_$type) 0.2
230        set DXTL(color_$type) [lindex $colorlist $row]
231    }
232    # Resize the list
233    update
234    set sizes [grid bbox $DXTL(lb)]
235    [winfo parent $DXTL(lb)] config -scrollregion $sizes \
236        -width [lindex $sizes 2]
237    set sizes [grid bbox $DXTL(Blst)]
238    [winfo parent $DXTL(Blst)] config -scrollregion $sizes \
239        -width [lindex $sizes 2]
240}
241
242# add bonds to bond list
243proc DXTLaddBond {} {
244    global DXTL
245    set colorlist "White Red Green Blue Yellow Cyan Magenta Black Orange Brown Grey Silver White"
246
247    if {$DXTL(bonds) == 0} {
248        # insert header
249        set row 0
250        grid [label $DXTL(Blst).a$row -text "from " -bg yellow\
251                 ] -column 1 -row $row  -sticky ew
252        grid [label $DXTL(Blst).b$row -text " to " -bg yellow\
253                 ] -column 2 -row $row  -sticky ew
254        grid [label $DXTL(Blst).c$row -text " width " -bg yellow\
255                 ] -column 3 -row $row  -sticky ew
256        grid [label $DXTL(Blst).d$row -text " min " -bg yellow\
257             ] -column 4 -row $row  -sticky ew
258        grid [label $DXTL(Blst).e$row -text " max " -bg yellow\
259                 ] -column 5 -row $row  -sticky ew
260        grid [label $DXTL(Blst).f$row -text " color " -bg yellow\
261                 ] -column 6 -row $row  -sticky ew
262    }
263    set row [incr DXTL(bonds)]
264    eval tk_optionMenu $DXTL(Blst).ta$row DXTL(ba_$row) $DXTL(typelist)
265    grid $DXTL(Blst).ta$row -column 1 -row $row
266    eval tk_optionMenu $DXTL(Blst).tb$row DXTL(bb_$row) $DXTL(typelist)
267    grid $DXTL(Blst).tb$row -column 2 -row $row
268    grid [entry $DXTL(Blst).w$row -textvariable DXTL(bw_$row) \
269              -width 5] -column 3 -row $row
270    grid [entry $DXTL(Blst).mi$row -textvariable DXTL(bmin_$row) \
271              -width 5] -column 4 -row $row
272    grid [entry $DXTL(Blst).mx$row -textvariable DXTL(bmax_$row) \
273              -width 5] -column 5 -row $row
274    eval tk_optionMenu $DXTL(Blst).c$row DXTL(bc_$row) $colorlist
275    grid $DXTL(Blst).c$row -column 6 -row $row
276    set DXTL(bw_$row) 0.02
277    set DXTL(bmin_$row) 1.0
278    set DXTL(bmax_$row) 2.0
279    set DXTL(bc_$row) [lindex $colorlist $row]
280    # Resize the list
281    update
282    set sizes [grid bbox $DXTL(Blst)]
283    [winfo parent $DXTL(Blst)] config -scrollregion $sizes \
284        -width [lindex $sizes 2]
285}
Note: See TracBrowser for help on using the repository browser.