| 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 |
|---|
| 5 | set label "export to DRAWXTL (.str) file" |
|---|
| 6 | set action export_drawxtl |
|---|
| 7 | proc 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 |
|---|
| 177 | proc 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 |
|---|
| 190 | proc 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 |
|---|
| 243 | proc 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 | } |
|---|
