Ignore:
Timestamp:
Aug 15, 2012 2:27:31 PM (9 years ago)
Author:
toby
Message:

start on Fourier calc and absorption constraints

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/sandbox/export_drawxtl.tcl

    r930 r1209  
    55set label "export to DRAWXTL (.str) file"
    66set action export_drawxtl
     7set DXTLcolorlist "White Red Green Blue Yellow Cyan Magenta Black Orange Brown Grey Silver White"
    78proc export_drawxtl {} {
    89    global expmap expgui
     
    2021#           "MakeWWWHelp expgui.html export"
    2122
    22     # force the window to stay on top
    23     putontop .export
    2423    # trigger a quit on window delete
    2524    wm protocol .export WM_DELETE_WINDOW {set expgui(export_phase) 0; destroy .export }
     
    4746        -row $row -column 1 -columnspan 5 -sticky w
    4847    incr row
    49     set colorlist "White Red Green Blue Yellow Cyan Magenta Black Orange Brown Grey Silver White"
    5048    set DXTL(arrowcolorbox) $bx.4a
    5149    set DXTL(arrowcolorbox_row) $row
     
    5452    grid [label $bx.4a.h -text "Arrow colors: "] -column 0 -row 1 -sticky w
    5553    grid [label $bx.4a.bll -text "   generated by Black operator "] -column 0 -row 2
    56     eval tk_optionMenu $bx.4a.bl DXTL(blackarrow) $colorlist
     54    eval tk_optionMenu $bx.4a.bl DXTL(blackarrow) $::DXTLcolorlist
    5755    grid $bx.4a.bl -column 2 -row 2
    5856    grid [label $bx.4a.redl -text "  generated by Red operator "] -column 0 -row 3
    59     eval tk_optionMenu $bx.4a.red DXTL(redarrow) $colorlist
     57    eval tk_optionMenu $bx.4a.red DXTL(redarrow) $::DXTLcolorlist
    6058    grid $bx.4a.red -column 2 -row 3
    6159    incr row
     
    131129    grid [scrollbar $bx.b.scroll \
    132130              -command "$bx.b.canvas yview"] -sticky ns -row $row -column 1
    133 
    134     trace variable expgui(export_phase) w SetDXTLatoms
     131    # Fourier Box
     132    incr row
     133    grid [frame $bx.f -relief groove -bd 4] -row $row -column 0 -columnspan 5 -sticky nsew
     134    grid [label $bx.f.0 -text "Fourier display" \
     135              -anchor w] -row 0 -column 0 -sticky w
     136    grid [frame $bx.f.1] -column 0 -row 1 -sticky news
     137    grid [frame $bx.f.2] -column 0 -row 2 -sticky news
     138    grid [canvas $bx.f.canvas -relief sunk -bd 2 \
     139              -scrollregion {0 0 5000 500} -width 250 -height 70 \
     140              -yscrollcommand "$bx.f.scroll set" ] \
     141        -column 0 -row 3 -sticky nsew
     142    grid columnconfig $bx.f 0 -weight 1
     143    frame [set DXTL(fb) $bx.f.canvas.fr]
     144    $bx.f.canvas create window 0 0 -anchor nw -window $DXTL(fb)
     145    grid [scrollbar $bx.f.scroll \
     146              -command "$bx.f.canvas yview"] -sticky ns -row 3 -column 1
     147    grid [button $bx.f.1.1 -text "Setup\nFourier" \
     148              -command EditFourier] -column 0 -row 0
     149    grid [button [set DXTL(FourCompute) $bx.f.1.2] -text "Compute\nFourier" \
     150              -command {DXTLwritegrd $expgui(export_phase)}] -column 1 -row 0
     151    grid [label $bx.f.1.3 -text "Select\nMap"] -column 3 -row 0
     152    set DXTL(fmenu) [tk_optionMenu $bx.f.1.4 DXTL(mtype) test]
     153    grid $bx.f.1.4 -column 4 -row 0
     154    grid [button [set DXTL(AddContour) $bx.f.1.5] -text "Add\nContour" \
     155              -command AddContour] -column 5 -row 0
     156    SetupFourierButtons
     157return
     158    # force the window to stay on top
     159    putontop .export
     160    trace variable expgui(export_phase) w "SetDXTLatoms;SetupFourierButtons"
    135161    SetDXTLatoms
    136162    # this appears to be needed by OSX
     
    212238            DXTLwriteArrows $fp $phase
    213239        }
     240        DXTLwriteFourierCommands
    214241        puts $fp "END"
    215242        close $fp
     
    246273proc SetDXTLatoms {args} {
    247274    global DXTL expgui expmap
    248     set colorlist "White Red Green Blue Yellow Cyan Magenta Black Orange Brown Grey Silver White"
    249275    eval destroy [winfo children $DXTL(lb)]
    250276    eval destroy [winfo children $DXTL(Blst)]
     
    290316        grid [entry $DXTL(lb).e$row -textvariable DXTL(radius_$type) \
    291317                -width 5] -column 2 -row $row
    292         eval tk_optionMenu $DXTL(lb).c$row DXTL(color_$type) $colorlist
     318        eval tk_optionMenu $DXTL(lb).c$row DXTL(color_$type) $::DXTLcolorlist
    293319        grid $DXTL(lb).c$row -column 3 -row $row
    294320        set DXTL(display_$type) sphere
    295321        set DXTL(radius_$type) 0.2
    296         set DXTL(color_$type) [lindex $colorlist $row]
     322        set DXTL(color_$type) [lindex $::DXTLcolorlist $row]
    297323    }
    298324    # Resize the list
     
    310336proc DXTLaddBond {} {
    311337    global DXTL
    312     set colorlist "White Red Green Blue Yellow Cyan Magenta Black Orange Brown Grey Silver White"
    313 
    314338    if {$DXTL(bonds) == 0} {
    315339        # insert header
     
    339363    grid [entry $DXTL(Blst).mx$row -textvariable DXTL(bmax_$row) \
    340364              -width 5] -column 5 -row $row
    341     eval tk_optionMenu $DXTL(Blst).c$row DXTL(bc_$row) $colorlist
     365    eval tk_optionMenu $DXTL(Blst).c$row DXTL(bc_$row) $::DXTLcolorlist
    342366    grid $DXTL(Blst).c$row -column 6 -row $row
    343367    set DXTL(bw_$row) 0.02
    344368    set DXTL(bmin_$row) 1.0
    345369    set DXTL(bmax_$row) 2.0
    346     set DXTL(bc_$row) [lindex $colorlist $row]
     370    set DXTL(bc_$row) [lindex $::DXTLcolorlist $row]
    347371    # Resize the list
    348372    update
     
    412436    puts $out "mag_trans 1. 0 0  0 1. 0  0 0 1."
    413437}
     438
     439# Computes a Fourier map(s) and converts the maps from binary to ascii
     440#   returns a list of Fourier map types
     441proc DXTLwritegrd {phase} {
     442    global expgui expmap DXTL
     443    set lst [listFourier]
     444    if {$lst < 1} {
     445        MyMessageBox -parent . -title "No Fourier" \
     446            -message "You have not set up to compute a Fourier map." \
     447            -icon warning
     448        return
     449    }
     450    set typelist {}
     451    foreach l $lst {
     452        lappend typelist [Fourierinfo $l type]
     453    }
     454    set hists [FourierHists $phase]
     455    # make sure we have default limits
     456    getFourierLimits $phase
     457    if {[llength $hists] < 1} {
     458        MyMessageBox -parent . -title "No Fourier" \
     459            -message "You have not set up to compute a Fourier map for phase $phase." \
     460            -icon warning
     461        return
     462    }
     463    if {$::tcl_platform(platform) == "windows"} {
     464        set map [file join $expgui(gsasexe) gsas2map.exe]
     465        set fourier [file join $expgui(gsasexe) fourier.exe]
     466    } else {
     467        set map [file join $expgui(gsasexe) gsas2map]
     468        set fourier [file join $expgui(gsasexe) fourier]
     469    }
     470    if {![file exists $map]} {
     471        MyMessageBox -parent . -title "No Map Converter prog" \
     472            -message "Error Fourier map converter program ($map) not found." \
     473            -icon warning
     474        return
     475    }
     476    if {![file exists $fourier]} {
     477        MyMessageBox -parent . -title "No Fourier prog" \
     478            -message "Error Fourier program ($fourier) not found." \
     479            -icon warning
     480        return
     481    }
     482    set fp [open f.in w]
     483    if {[llength $typelist] > 1} {
     484        puts $fp [lindex $typelist 0]
     485    }
     486    puts $fp "E"
     487    foreach t [lrange $typelist 1 end] {
     488        puts $fp "F $t"
     489        puts $fp "E"
     490    }
     491    puts $fp "q"
     492    close $fp
     493    # delete any old grd files
     494    foreach f [glob -nocomplain "[file root $expgui(expfile)]*.grd"] {
     495        catch {file delete -force $f}
     496    }
     497    set deleteerror 0
     498    if {[llength [glob -nocomplain "[file root $expgui(expfile)]*.grd"]] >0} {
     499        MyMessageBox -parent . -title "Old grd files?" \
     500            -message "Warning: Could not delete old .grd files; it will probably not be possible to overwrite them either. Be aware that map results may be out of date." \
     501            -icon warning
     502        set deleteerror 1
     503    }
     504    catch {
     505        exec $fourier [file root $expgui(expfile)] >& f.out
     506        exec $map [file root $expgui(expfile)] < f.in >>& f.out
     507    }
     508    if {[llength [glob -nocomplain "[file root $expgui(expfile)]*.grd"]] == 0} {
     509        set fp [open f.out r]
     510        set lines {}
     511        while {[gets $fp line] >= 0} {
     512            append lines $line "\n"
     513        }
     514        close $fp
     515        MyMessageBox -parent . -title "No grd files" \
     516            -message "Error: no .grd files were created. See log file below\n\n$lines" \
     517            -icon error
     518        return {}
     519    } else {
     520        catch {close $fp}
     521        catch {file delete -force f.in f.out}
     522        return $typelist
     523    }
     524}
     525
     526proc SetupFourierButtons {} {
     527    set phase $::expgui(export_phase)
     528    $::DXTL(FourCompute) config -state disabled
     529    $::DXTL(AddContour) config -state disabled
     530    $::DXTL(fmenu) delete 0 end
     531    set ::DXTL(mtype) ""
     532    set ::DXTL(mfil) ""
     533    # if the Fourier is not set up; return here
     534    if {[listFourier] < 1} return
     535    if {[llength [FourierHists $phase]] < 1} return
     536    # make sure we have default limits
     537    getFourierLimits $phase
     538    $::DXTL(FourCompute) config -state normal
     539    # if there are no maps, return here
     540    set maps [glob -nocomplain "[file root $::expgui(expfile)]*.grd"]
     541    if {[llength $maps] < 1} return
     542    set types {}
     543    foreach fil $maps {
     544        lappend types [lindex [split [file root [file tail $fil]] "_"] end]
     545    }
     546    $::DXTL(AddContour) config -state normal
     547    set i 0
     548    foreach fil $maps lbl $types {
     549        if {$i == 1} {$::DXTL(fmenu) invoke 0}
     550        incr i
     551        $::DXTL(fmenu) add command -label $lbl \
     552            -command "set DXTL(mtype) $lbl; set DXTL(mfil) $fil"
     553    }
     554}
     555
     556proc EditFourier {} {
     557    error
     558}
     559
     560proc AddContour {} {
     561    error
     562}
     563
     564proc DXTLwriteFourierCommands {} {
     565    error
     566    #mapread grd 10CO_DELF.grd 4
     567    #mapcontour  2.000 mesh Green
     568    #mapcontour  2.500 solid Blue
     569}
Note: See TracChangeset for help on using the changeset viewer.