Changeset 836 for trunk

Timestamp:

Dec 4, 2009 5:12:52 PM (13 years ago)

Author:

toby

Message:

# 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.

File:

• trunk/export_drawxtl.tcl (modified) (5 diffs, 3 props)

trunk/export_drawxtl.tcl

@@ -24 +24 @@
     set bx .export.special
     global DXTL
-    set DXTL(bonds) 0
+    if {[info global DXTL] == ""} {
+        set DXTL(bonds) 0
+        set DXTL(coords) 1
+        set DXTL(blackarrow) Green
+        set DXTL(redarrow) Red
+    }
     set row 1
     grid [label $bx.1 -text "Title:"] -column 1 -row $row -sticky e
@@ -31 +36 @@
     set DXTL(title) [expinfo title]
     incr row
-    set DXTL(coords) 1
     grid [checkbutton $bx.3 -text "Include coordinates in .str file" \
               -variable DXTL(coords)] \
+        -row $row -column 1 -columnspan 5 -sticky w
+    incr row
+    set DXTL(arrowbox) $bx.4
+    grid [checkbutton $bx.4 -text "Generate arrows for magnetic atoms" \
+              -variable DXTL(genarrows) -state disabled] \
+        -row $row -column 1 -columnspan 5 -sticky w
+    incr row
+    set colorlist "White Red Green Blue Yellow Cyan Magenta Black Orange Brown Grey Silver White"
+    set DXTL(arrowcolorbox) $bx.4a
+    grid [frame $bx.4a] -sticky ew -row $row -column 1 -columnspan 5
+    grid [label $bx.4a.h -text "Representation: "] -column 0 -row 1
+    grid [label $bx.4a.bll -text "gen from Block operator "] -column 1 -row 1
+    eval tk_optionMenu $bx.4a.bl DXTL(blackarrow) $colorlist
+    grid $bx.4a.bl -column 2 -row 1
+    grid [label $bx.4a.redl -text "gen from Red operator "] -column 1 -row 2
+    eval tk_optionMenu $bx.4a.red DXTL(redarrow) $colorlist
+    grid $bx.4a.red -column 2 -row 2
+    incr row
+    foreach appname {DRAWxtl41 DRAWxtl41_aqua DRAWxtl50 DRAWxtl51} {
+        set app [auto_execok $appname]
+        if {$app != ""} {break}
+        foreach loc [list $expgui(scriptdir) \
+                         ~/Applications/DRAWxtlxx1/DRAWxtl501/] {
+            if {[file exists [file join $loc $appname]]} {
+                set app [file join $loc $appname]
+                break
+            }
+        }
+        if {$app != ""} {break}
+    }
+    if {$app != ""} {
+        set show normal
+        set DXTL(app) $app
+        set DXTL(launch) 1
+    } else {
+        set show disabled
+        set DXTL(launch) 0
+    }
+    grid [checkbutton $bx.l -text "Launch DRAWxtl" \
+              -variable DXTL(launch) -state $show] \
         -row $row -column 1 -columnspan 5 -sticky w
     incr row
@@ -159 +203 @@
             puts $fp "bond $DXTL(ba_$i) $DXTL(bb_$i) $DXTL(bw_$i) $DXTL(bmin_$i) $DXTL(bmax_$i) $DXTL(bc_$i)"
         }
+        # list arrows, when requested
+        if {[lindex $expmap(phasetype) [expr {$phase - 1}]] != 1 && \
+                $DXTL(genarrows)} {
+            DXTLwriteArrows $fp $phase
+        }
         puts $fp "END"
         close $fp
+        if {$DXTL(launch)} {
+            exec $DXTL(app) $filnam &
+        }
     } errmsg] {
         MyMessageBox -parent . -title "Export error" \
@@ -201 +253 @@
             -icon warning
         return
+    }
+    if {[lindex $expmap(phasetype) [expr {$phase - 1}]] == 1} {
+        set DXTL(genarrows) 0
+        $DXTL(arrowbox) configure -state disabled
+        grid forget $DXTL(arrowcolorbox) 
+    } else {
+        set DXTL(genarrows) 1
+        $DXTL(arrowbox) configure -state normal
+        grid $DXTL(arrowcolorbox) 
     }
     catch {unset typelist}
@@ -284 +345 @@
         -width [lindex $sizes 2]
 }
+
+proc DXTLwriteArrows {out phase} {
+    global expgui expmap DXTL
+    set fp [open geom.in w]
+    puts $fp "N"
+    puts $fp "M"
+    if {[llength $expmap(phaselist)] > 1} {
+        puts $fp "$phase"
+    }
+    puts $fp "N"
+    puts $fp "X"
+    close $fp
+    catch {
+        if {$::tcl_platform(platform) == "windows"} {
+            exec [file join $expgui(gsasexe) geometry.exe] \
+                [file root $expgui(expfile)] < geom.in >& geom.out
+        } else {
+            exec [file join $expgui(gsasexe) geometry] \
+                [file root $expgui(expfile)] < geom.in >& geom.out
+        }
+        set fp [open geom.out r]
+        while {[gets $fp line] >= 0} {
+            if {[string match "*name*elem*x *y *z*x *y *z*" $line]} {break}
+        }
+        set i 0
+        while {[gets $fp line] >= 0} {
+            if {[string match "*Enter Geometry option*" $line]} {break}
+            incr i
+            if {$i == 2} {
+                set name [string trim [string range $line 5 12]]
+                set tail [string trim [string range $line 22 end]]
+                set pos [lrange $tail 0 2]
+                set spin [lindex $tail end]
+            } elseif {$i == 5} {
+                set vec [string trim [string range $line 22 end]]
+                if {[catch {set count($name)}]} {set count($name) 0}
+                catch {
+                    set k ?
+                    incr count($name)
+                    set k $count($name)
+                }
+                puts $out "rem spin for atom $name # $k ($spin)"
+                if {$spin == "Red"} {
+                    puts $out "arrow $pos     $vec    1. 0.15 $DXTL(redarrow)"
+                } else {
+                    puts $out "arrow $pos     $vec    1. 0.15 $DXTL(blackarrow)"
+                }
+            } elseif {$i == 6} {
+                set i 1
+            }
+        }
+    }
+    catch {close $fp}
+    catch {file delete -force geom.in geom.out}
+    puts $out "mag_trans 1. 0 0  0 1. 0  0 0 1."
+}