Ignore:
Timestamp:
Dec 4, 2009 5:12:52 PM (11 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:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/export_drawxtl.tcl

    • Property rcs:date changed from 2004/09/21 23:14:14 to 2005/03/24 21:40:23
    • Property rcs:rev changed from 1.1 to 1.2
    • Property rcs:lines set to +120 -3
    r807 r836  
    2424    set bx .export.special
    2525    global DXTL
    26     set DXTL(bonds) 0
     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    }
    2732    set row 1
    2833    grid [label $bx.1 -text "Title:"] -column 1 -row $row -sticky e
     
    3136    set DXTL(title) [expinfo title]
    3237    incr row
    33     set DXTL(coords) 1
    3438    grid [checkbutton $bx.3 -text "Include coordinates in .str file" \
    3539              -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] \
    3680        -row $row -column 1 -columnspan 5 -sticky w
    3781    incr row
     
    159203            puts $fp "bond $DXTL(ba_$i) $DXTL(bb_$i) $DXTL(bw_$i) $DXTL(bmin_$i) $DXTL(bmax_$i) $DXTL(bc_$i)"
    160204        }
     205        # list arrows, when requested
     206        if {[lindex $expmap(phasetype) [expr {$phase - 1}]] != 1 && \
     207                $DXTL(genarrows)} {
     208            DXTLwriteArrows $fp $phase
     209        }
    161210        puts $fp "END"
    162211        close $fp
     212        if {$DXTL(launch)} {
     213            exec $DXTL(app) $filnam &
     214        }
    163215    } errmsg] {
    164216        MyMessageBox -parent . -title "Export error" \
     
    201253            -icon warning
    202254        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)
    203264    }
    204265    catch {unset typelist}
     
    284345        -width [lindex $sizes 2]
    285346}
     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 TracChangeset for help on using the changeset viewer.