source: trunk/export_drawxtl.tcl @ 836

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

# on 2005/03/24 21:40:23, toby did:
major revision
Allow arrow colors, number comments on arrows
Look for DRAWxtl (not in enough places) and offer to launch it
oops -- the entire arrow routine is new.

  • Property rcs:author set to toby
  • Property rcs:date set to 2005/03/24 21:40:23
  • Property rcs:lines set to +120 -3
  • Property rcs:rev set to 1.2
  • Property rcs:state set to Exp
  • Property svn:keywords set to Author Date Revision Id
File size: 14.2 KB
Line 
1# export a phase to DRAWXTL
2#
3# $Id: export_drawxtl.tcl 836 2009-12-04 23:12:52Z 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    if {[info global DXTL] == ""} {
27        set DXTL(bonds) 0
28        set DXTL(coords) 1
29        set DXTL(blackarrow) Green
30        set DXTL(redarrow) Red
31    }
32    set row 1
33    grid [label $bx.1 -text "Title:"] -column 1 -row $row -sticky e
34    grid [entry $bx.2 -textvariable DXTL(title) -width 40] \
35        -row $row -column 2 -columnspan 5 -sticky w
36    set DXTL(title) [expinfo title]
37    incr row
38    grid [checkbutton $bx.3 -text "Include coordinates in .str file" \
39              -variable DXTL(coords)] \
40        -row $row -column 1 -columnspan 5 -sticky w
41    incr row
42    set DXTL(arrowbox) $bx.4
43    grid [checkbutton $bx.4 -text "Generate arrows for magnetic atoms" \
44              -variable DXTL(genarrows) -state disabled] \
45        -row $row -column 1 -columnspan 5 -sticky w
46    incr row
47    set colorlist "White Red Green Blue Yellow Cyan Magenta Black Orange Brown Grey Silver White"
48    set DXTL(arrowcolorbox) $bx.4a
49    grid [frame $bx.4a] -sticky ew -row $row -column 1 -columnspan 5
50    grid [label $bx.4a.h -text "Representation: "] -column 0 -row 1
51    grid [label $bx.4a.bll -text "gen from Block operator "] -column 1 -row 1
52    eval tk_optionMenu $bx.4a.bl DXTL(blackarrow) $colorlist
53    grid $bx.4a.bl -column 2 -row 1
54    grid [label $bx.4a.redl -text "gen from Red operator "] -column 1 -row 2
55    eval tk_optionMenu $bx.4a.red DXTL(redarrow) $colorlist
56    grid $bx.4a.red -column 2 -row 2
57    incr row
58    foreach appname {DRAWxtl41 DRAWxtl41_aqua DRAWxtl50 DRAWxtl51} {
59        set app [auto_execok $appname]
60        if {$app != ""} {break}
61        foreach loc [list $expgui(scriptdir) \
62                         ~/Applications/DRAWxtlxx1/DRAWxtl501/] {
63            if {[file exists [file join $loc $appname]]} {
64                set app [file join $loc $appname]
65                break
66            }
67        }
68        if {$app != ""} {break}
69    }
70    if {$app != ""} {
71        set show normal
72        set DXTL(app) $app
73        set DXTL(launch) 1
74    } else {
75        set show disabled
76        set DXTL(launch) 0
77    }
78    grid [checkbutton $bx.l -text "Launch DRAWxtl" \
79              -variable DXTL(launch) -state $show] \
80        -row $row -column 1 -columnspan 5 -sticky w
81    incr row
82    grid [frame $bx.c -relief groove -bd 4] -row $row -column 0 -columnspan 5
83    grid [label $bx.c.0 -text "Range of fractional coordinates to include" \
84              -anchor center] -row 0 -column 0 -columnspan 8
85    foreach v {x y z} V {X Y Z} {
86        incr row
87        grid [label $bx.c.${v}1 -text "${V} min:"] -column 1 -row $row
88        grid [entry $bx.c.${v}2 -textvariable DXTL(${v}min) -width 4] -column 2 -row $row
89        grid [scale $bx.c.${v}3 -resolution 0.1 -variable DXTL(${v}min) \
90                  -showvalue 0 -orient h -from -2 -to 1] -column 3 -row $row
91        set DXTL(${v}min) -0.1
92        grid [label $bx.c.${v}4 -text " max:"] -column 4 -row $row
93        grid [entry $bx.c.${v}5 -textvariable DXTL(${v}max) -width 4] -column 5 -row $row
94        grid [scale $bx.c.${v}6 -resolution 0.1 -variable DXTL(${v}max) \
95                  -showvalue 0 -orient h -from 0 -to 3] -column 6 -row $row
96        set DXTL(${v}max) 1.1
97    }
98    # atom type box
99    grid [frame $bx.s -relief groove -bd 4] -row $row -column 0 -columnspan 5 -sticky ew
100    grid [label $bx.s.0 -text "Atom representation" \
101              -anchor w] -row 0 -column 0 -sticky w
102    grid [canvas $bx.s.canvas -relief sunk -bd 2 \
103              -scrollregion {0 0 5000 500} -width 250 -height 70 \
104              -yscrollcommand "$bx.s.scroll set" ] \
105        -column 0 -row [incr row] -sticky nsew
106    grid columnconfig $bx.s 0 -weight 1
107    frame [set DXTL(lb) $bx.s.canvas.fr]
108    $bx.s.canvas create window 0 0 -anchor nw -window $DXTL(lb)
109    grid [scrollbar $bx.s.scroll \
110              -command "$bx.s.canvas yview"] -sticky ns -row $row -column 1
111    # bond box
112    incr row
113    grid [frame $bx.b -relief groove -bd 4] -row $row -column 0 -columnspan 5 -sticky ew
114    grid [frame $bx.b.0] -row 0 -column 0 -columnspan 7 -sticky ew
115    grid [label $bx.b.0.1 -text "Bond List" \
116              -anchor w] -row 0 -column 0 -sticky w
117    grid columnconfig $bx.b.0 0 -weight 1
118    grid [button $bx.b.0.b -text "Add Bond" -command DXTLaddBond \
119             ] -row 0 -column 1 -sticky e
120    grid [canvas $bx.b.canvas -relief sunk -bd 2 \
121              -scrollregion {0 0 5000 500} -width 250 -height 70 \
122              -yscrollcommand "$bx.b.scroll set" ] \
123        -column 0 -row [incr row] -sticky nsew
124    grid columnconfig $bx.b 0 -weight 1
125    frame [set DXTL(Blst) $bx.b.canvas.fr]
126    $bx.b.canvas create window 0 0 -anchor nw -window $DXTL(Blst)
127    grid [scrollbar $bx.b.scroll \
128              -command "$bx.b.canvas yview"] -sticky ns -row $row -column 1
129
130    trace variable expgui(export_phase) w SetDXTLatoms
131    SetDXTLatoms
132    # this appears to be needed by OSX
133    ResizeWin .export
134
135    # Wait for the Write or Quit button to be pressed
136    tkwait window .export
137    afterputontop
138    # test for Quit
139    if {$expgui(export_phase) == 0} {return}
140
141    # now open the file and write it
142    set phase $expgui(export_phase)
143    if [catch {
144        set filnam [file rootname $expgui(expfile)]_${phase}.str
145        set fp [open $filnam w]
146        # deal with macromolecular phases
147        if {[lindex $expmap(phasetype) [expr {$phase - 1}]] == 4} {
148            MyMessageBox -parent . -title "MM phase" \
149                -message "Sorry, macromolecular phases cannot be processed" \
150                -icon warning
151            return
152        }
153        catch {unset typelist}
154        foreach atom $expmap(atomlist_$phase) {
155            set typelist([atominfo $phase $atom type]) 1
156        }
157        # title info from GSAS title & phase title
158        puts $fp "REM  created by EXPGUI from $expgui(expfile) on [clock format [clock seconds]]"
159        puts $fp "title \"$DXTL(title)\""
160        puts $fp "pack $DXTL(xmin) $DXTL(xmax) $DXTL(ymin) $DXTL(ymax) $DXTL(zmin) $DXTL(zmax)"
161        puts $fp "edges 0.02 Black"
162        puts $fp "phong 1.0 30."
163        foreach type [array names typelist] {
164            if {$DXTL(display_$type) == "sphere"} {
165                puts $fp "sphere $type $DXTL(radius_$type) $DXTL(color_$type)"
166            } elseif {$DXTL(display_$type) == "polyhedron"} {
167                puts $fp "polysz $type $DXTL(radius_$type) $DXTL(color_$type)"
168            } elseif {$DXTL(display_$type) == "ellipsoid"} {
169                puts $fp "ellipcolor $type * $DXTL(color_$type)"
170            }
171        }
172        if {$DXTL(coords)} {
173            # write out cell parameters
174            puts -nonewline $fp "cell"
175            foreach p {a b c alpha beta gamma} {
176                puts -nonewline $fp " [phaseinfo $phase $p]"
177            }
178            puts $fp ""
179            # write out GSAS spacegroup
180            puts $fp "spgp [phaseinfo $phase spacegroup]"
181            # now loop over atoms
182            foreach atom $expmap(atomlist_$phase) {
183                puts -nonewline $fp "atom [atominfo $phase $atom type] $atom "
184                foreach v {x y z} {
185                    puts -nonewline $fp "[atominfo $phase $atom $v] "
186                }
187                puts $fp ""
188               
189                set uiso [atominfo $phase $atom Uiso]
190                # are there anisotropic atoms? If so convert them to Uequiv
191                if {[atominfo $phase $atom temptype] == "A"} {
192                    puts -nonewline $fp "Uij [atominfo $phase $atom type] $atom "
193                    foreach v {U11 U22 U33 U12 U13 U23} {
194                        puts -nonewline $fp "[atominfo $phase $atom $v] "
195                    }
196                    puts $fp ""
197                }
198            }
199        } else {
200            puts $fp "import gsas [file tail $expgui(expfile)] $phase"
201        }
202        for {set i 1} {$i <= $DXTL(bonds)} {incr i} {
203            puts $fp "bond $DXTL(ba_$i) $DXTL(bb_$i) $DXTL(bw_$i) $DXTL(bmin_$i) $DXTL(bmax_$i) $DXTL(bc_$i)"
204        }
205        # list arrows, when requested
206        if {[lindex $expmap(phasetype) [expr {$phase - 1}]] != 1 && \
207                $DXTL(genarrows)} {
208            DXTLwriteArrows $fp $phase
209        }
210        puts $fp "END"
211        close $fp
212        if {$DXTL(launch)} {
213            exec $DXTL(app) $filnam &
214        }
215    } errmsg] {
216        MyMessageBox -parent . -title "Export error" \
217                -message "Export error: $errmsg" -icon warning
218    } else {
219        MyMessageBox -parent . -title "Done" \
220                -message "File [file tail $filnam] was written"
221    }
222    catch {unset DXTL}
223    foreach t [trace vinfo expgui(export_phase)] {
224        eval trace vdelete expgui(export_phase) $t
225    }
226 }
227
228# resize windows -- this appears to be needed by OSX 10.2
229proc ResizeWin {win} {
230    update
231    wm geom $win [winfo reqwidth $win]x[winfo reqheight $win]
232    # center the EXPGUI window
233    wm withdraw $win
234    set x [expr [winfo screenwidth $win]/2 - [winfo reqwidth $win]/2 ]
235    set y [expr [winfo screenheight $win]/2 - [winfo reqheight $win]/2]
236    wm geom $win +$x+$y
237    wm deiconify $win
238}
239
240
241# add atoms to atom representation list
242proc SetDXTLatoms {args} {
243    global DXTL expgui expmap
244    set colorlist "White Red Green Blue Yellow Cyan Magenta Black Orange Brown Grey Silver White"
245    eval destroy [winfo children $DXTL(lb)]
246    eval destroy [winfo children $DXTL(Blst)]
247    set DXTL(bonds) 0
248    if {$expgui(export_phase) == 0} {return}
249    set phase $expgui(export_phase)
250    if {[lindex $expmap(phasetype) [expr {$phase - 1}]] == 4} {
251        MyMessageBox -parent . -title "MM phase" \
252            -message "Sorry, macromolecular phases cannot be processed" \
253            -icon warning
254        return
255    }
256    if {[lindex $expmap(phasetype) [expr {$phase - 1}]] == 1} {
257        set DXTL(genarrows) 0
258        $DXTL(arrowbox) configure -state disabled
259        grid forget $DXTL(arrowcolorbox) 
260    } else {
261        set DXTL(genarrows) 1
262        $DXTL(arrowbox) configure -state normal
263        grid $DXTL(arrowcolorbox) 
264    }
265    catch {unset typelist}
266    set DXTL(title)  [phaseinfo $phase name]
267    foreach atom $expmap(atomlist_$phase) {
268        set typelist([atominfo $phase $atom type]) 1
269    }
270    set DXTL(typelist) [array names typelist]
271    set row 0
272    grid [label $DXTL(lb).l$row -text "type " -bg yellow\
273             ] -column 0 -row $row  -sticky ew
274    grid [label $DXTL(lb).d$row -text " representation " -bg yellow
275         ] -column 1 -row $row -sticky ew
276    grid [label $DXTL(lb).e$row -text " radius " -bg yellow\
277             ] -column 2 -row $row -sticky ew
278    grid [label $DXTL(lb).c$row -text " color " -bg yellow\
279             ] -column 3 -row $row -sticky ew
280    foreach type [array names typelist] {
281        incr row
282        grid [label $DXTL(lb).l$row -text $type] -column 0 -row $row
283        tk_optionMenu $DXTL(lb).d$row DXTL(display_$type) sphere polyhedron ellipsoid none
284        grid $DXTL(lb).d$row -column 1 -row $row
285        grid [entry $DXTL(lb).e$row -textvariable DXTL(radius_$type) \
286                -width 5] -column 2 -row $row
287        eval tk_optionMenu $DXTL(lb).c$row DXTL(color_$type) $colorlist
288        grid $DXTL(lb).c$row -column 3 -row $row
289        set DXTL(display_$type) sphere
290        set DXTL(radius_$type) 0.2
291        set DXTL(color_$type) [lindex $colorlist $row]
292    }
293    # Resize the list
294    update
295    set sizes [grid bbox $DXTL(lb)]
296    [winfo parent $DXTL(lb)] config -scrollregion $sizes \
297        -width [lindex $sizes 2]
298    set sizes [grid bbox $DXTL(Blst)]
299    [winfo parent $DXTL(Blst)] config -scrollregion $sizes \
300        -width [lindex $sizes 2]
301}
302
303# add bonds to bond list
304proc DXTLaddBond {} {
305    global DXTL
306    set colorlist "White Red Green Blue Yellow Cyan Magenta Black Orange Brown Grey Silver White"
307
308    if {$DXTL(bonds) == 0} {
309        # insert header
310        set row 0
311        grid [label $DXTL(Blst).a$row -text "from " -bg yellow\
312                 ] -column 1 -row $row  -sticky ew
313        grid [label $DXTL(Blst).b$row -text " to " -bg yellow\
314                 ] -column 2 -row $row  -sticky ew
315        grid [label $DXTL(Blst).c$row -text " width " -bg yellow\
316                 ] -column 3 -row $row  -sticky ew
317        grid [label $DXTL(Blst).d$row -text " min " -bg yellow\
318             ] -column 4 -row $row  -sticky ew
319        grid [label $DXTL(Blst).e$row -text " max " -bg yellow\
320                 ] -column 5 -row $row  -sticky ew
321        grid [label $DXTL(Blst).f$row -text " color " -bg yellow\
322                 ] -column 6 -row $row  -sticky ew
323    }
324    set row [incr DXTL(bonds)]
325    eval tk_optionMenu $DXTL(Blst).ta$row DXTL(ba_$row) $DXTL(typelist)
326    grid $DXTL(Blst).ta$row -column 1 -row $row
327    eval tk_optionMenu $DXTL(Blst).tb$row DXTL(bb_$row) $DXTL(typelist)
328    grid $DXTL(Blst).tb$row -column 2 -row $row
329    grid [entry $DXTL(Blst).w$row -textvariable DXTL(bw_$row) \
330              -width 5] -column 3 -row $row
331    grid [entry $DXTL(Blst).mi$row -textvariable DXTL(bmin_$row) \
332              -width 5] -column 4 -row $row
333    grid [entry $DXTL(Blst).mx$row -textvariable DXTL(bmax_$row) \
334              -width 5] -column 5 -row $row
335    eval tk_optionMenu $DXTL(Blst).c$row DXTL(bc_$row) $colorlist
336    grid $DXTL(Blst).c$row -column 6 -row $row
337    set DXTL(bw_$row) 0.02
338    set DXTL(bmin_$row) 1.0
339    set DXTL(bmax_$row) 2.0
340    set DXTL(bc_$row) [lindex $colorlist $row]
341    # Resize the list
342    update
343    set sizes [grid bbox $DXTL(Blst)]
344    [winfo parent $DXTL(Blst)] config -scrollregion $sizes \
345        -width [lindex $sizes 2]
346}
347
348proc DXTLwriteArrows {out phase} {
349    global expgui expmap DXTL
350    set fp [open geom.in w]
351    puts $fp "N"
352    puts $fp "M"
353    if {[llength $expmap(phaselist)] > 1} {
354        puts $fp "$phase"
355    }
356    puts $fp "N"
357    puts $fp "X"
358    close $fp
359    catch {
360        if {$::tcl_platform(platform) == "windows"} {
361            exec [file join $expgui(gsasexe) geometry.exe] \
362                [file root $expgui(expfile)] < geom.in >& geom.out
363        } else {
364            exec [file join $expgui(gsasexe) geometry] \
365                [file root $expgui(expfile)] < geom.in >& geom.out
366        }
367        set fp [open geom.out r]
368        while {[gets $fp line] >= 0} {
369            if {[string match "*name*elem*x *y *z*x *y *z*" $line]} {break}
370        }
371        set i 0
372        while {[gets $fp line] >= 0} {
373            if {[string match "*Enter Geometry option*" $line]} {break}
374            incr i
375            if {$i == 2} {
376                set name [string trim [string range $line 5 12]]
377                set tail [string trim [string range $line 22 end]]
378                set pos [lrange $tail 0 2]
379                set spin [lindex $tail end]
380            } elseif {$i == 5} {
381                set vec [string trim [string range $line 22 end]]
382                if {[catch {set count($name)}]} {set count($name) 0}
383                catch {
384                    set k ?
385                    incr count($name)
386                    set k $count($name)
387                }
388                puts $out "rem spin for atom $name # $k ($spin)"
389                if {$spin == "Red"} {
390                    puts $out "arrow $pos     $vec    1. 0.15 $DXTL(redarrow)"
391                } else {
392                    puts $out "arrow $pos     $vec    1. 0.15 $DXTL(blackarrow)"
393                }
394            } elseif {$i == 6} {
395                set i 1
396            }
397        }
398    }
399    catch {close $fp}
400    catch {file delete -force geom.in geom.out}
401    puts $out "mag_trans 1. 0 0  0 1. 0  0 0 1."
402}
Note: See TracBrowser for help on using the repository browser.