Changeset 1209 for branches/sandbox/export_drawxtl.tcl

Timestamp:

Aug 15, 2012 2:27:31 PM (9 years ago)

Author:

toby

Message:

start on Fourier calc and absorption constraints

File:

• branches/sandbox/export_drawxtl.tcl (modified) (11 diffs)

branches/sandbox/export_drawxtl.tcl

@@ -5 +5 @@
 set label "export to DRAWXTL (.str) file"
 set action export_drawxtl
+set DXTLcolorlist "White Red Green Blue Yellow Cyan Magenta Black Orange Brown Grey Silver White"
 proc export_drawxtl {} {
     global expmap expgui
@@ -20 +21 @@
 #           "MakeWWWHelp expgui.html export"
 
-    # force the window to stay on top
-    putontop .export
     # trigger a quit on window delete
     wm protocol .export WM_DELETE_WINDOW {set expgui(export_phase) 0; destroy .export }
@@ -47 +46 @@
         -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
     set DXTL(arrowcolorbox_row) $row
@@ -54 +52 @@
     grid [label $bx.4a.h -text "Arrow colors: "] -column 0 -row 1 -sticky w
     grid [label $bx.4a.bll -text "   generated by Black operator "] -column 0 -row 2
-    eval tk_optionMenu $bx.4a.bl DXTL(blackarrow) $colorlist
+    eval tk_optionMenu $bx.4a.bl DXTL(blackarrow) $::DXTLcolorlist
     grid $bx.4a.bl -column 2 -row 2
     grid [label $bx.4a.redl -text "  generated by Red operator "] -column 0 -row 3
-    eval tk_optionMenu $bx.4a.red DXTL(redarrow) $colorlist
+    eval tk_optionMenu $bx.4a.red DXTL(redarrow) $::DXTLcolorlist
     grid $bx.4a.red -column 2 -row 3
     incr row
@@ -131 +129 @@
     grid [scrollbar $bx.b.scroll \
               -command "$bx.b.canvas yview"] -sticky ns -row $row -column 1
-
-    trace variable expgui(export_phase) w SetDXTLatoms
+    # Fourier Box
+    incr row
+    grid [frame $bx.f -relief groove -bd 4] -row $row -column 0 -columnspan 5 -sticky nsew
+    grid [label $bx.f.0 -text "Fourier display" \
+              -anchor w] -row 0 -column 0 -sticky w
+    grid [frame $bx.f.1] -column 0 -row 1 -sticky news
+    grid [frame $bx.f.2] -column 0 -row 2 -sticky news
+    grid [canvas $bx.f.canvas -relief sunk -bd 2 \
+              -scrollregion {0 0 5000 500} -width 250 -height 70 \
+              -yscrollcommand "$bx.f.scroll set" ] \
+        -column 0 -row 3 -sticky nsew
+    grid columnconfig $bx.f 0 -weight 1
+    frame [set DXTL(fb) $bx.f.canvas.fr]
+    $bx.f.canvas create window 0 0 -anchor nw -window $DXTL(fb)
+    grid [scrollbar $bx.f.scroll \
+              -command "$bx.f.canvas yview"] -sticky ns -row 3 -column 1
+    grid [button $bx.f.1.1 -text "Setup\nFourier" \
+              -command EditFourier] -column 0 -row 0
+    grid [button [set DXTL(FourCompute) $bx.f.1.2] -text "Compute\nFourier" \
+              -command {DXTLwritegrd $expgui(export_phase)}] -column 1 -row 0
+    grid [label $bx.f.1.3 -text "Select\nMap"] -column 3 -row 0
+    set DXTL(fmenu) [tk_optionMenu $bx.f.1.4 DXTL(mtype) test]
+    grid $bx.f.1.4 -column 4 -row 0
+    grid [button [set DXTL(AddContour) $bx.f.1.5] -text "Add\nContour" \
+              -command AddContour] -column 5 -row 0
+    SetupFourierButtons
+return
+    # force the window to stay on top
+    putontop .export
+    trace variable expgui(export_phase) w "SetDXTLatoms;SetupFourierButtons"
     SetDXTLatoms
     # this appears to be needed by OSX
@@ -212 +238 @@
             DXTLwriteArrows $fp $phase
         }
+        DXTLwriteFourierCommands
         puts $fp "END"
         close $fp
@@ -246 +273 @@
 proc SetDXTLatoms {args} {
     global DXTL expgui expmap
-    set colorlist "White Red Green Blue Yellow Cyan Magenta Black Orange Brown Grey Silver White"
     eval destroy [winfo children $DXTL(lb)]
     eval destroy [winfo children $DXTL(Blst)]
@@ -290 +316 @@
         grid [entry $DXTL(lb).e$row -textvariable DXTL(radius_$type) \
                 -width 5] -column 2 -row $row
-        eval tk_optionMenu $DXTL(lb).c$row DXTL(color_$type) $colorlist
+        eval tk_optionMenu $DXTL(lb).c$row DXTL(color_$type) $::DXTLcolorlist
         grid $DXTL(lb).c$row -column 3 -row $row
         set DXTL(display_$type) sphere
         set DXTL(radius_$type) 0.2
-        set DXTL(color_$type) [lindex $colorlist $row]
+        set DXTL(color_$type) [lindex $::DXTLcolorlist $row]
     }
     # Resize the list
@@ -310 +336 @@
 proc DXTLaddBond {} {
     global DXTL
-    set colorlist "White Red Green Blue Yellow Cyan Magenta Black Orange Brown Grey Silver White"
-
     if {$DXTL(bonds) == 0} {
         # insert header
@@ -339 +363 @@
     grid [entry $DXTL(Blst).mx$row -textvariable DXTL(bmax_$row) \
               -width 5] -column 5 -row $row
-    eval tk_optionMenu $DXTL(Blst).c$row DXTL(bc_$row) $colorlist
+    eval tk_optionMenu $DXTL(Blst).c$row DXTL(bc_$row) $::DXTLcolorlist
     grid $DXTL(Blst).c$row -column 6 -row $row
     set DXTL(bw_$row) 0.02
     set DXTL(bmin_$row) 1.0
     set DXTL(bmax_$row) 2.0
-    set DXTL(bc_$row) [lindex $colorlist $row]
+    set DXTL(bc_$row) [lindex $::DXTLcolorlist $row]
     # Resize the list
     update
@@ -412 +436 @@
     puts $out "mag_trans 1. 0 0  0 1. 0  0 0 1."
 }
+
+# Computes a Fourier map(s) and converts the maps from binary to ascii
+#   returns a list of Fourier map types
+proc DXTLwritegrd {phase} {
+    global expgui expmap DXTL
+    set lst [listFourier]
+    if {$lst < 1} {
+        MyMessageBox -parent . -title "No Fourier" \
+            -message "You have not set up to compute a Fourier map." \
+            -icon warning
+        return
+    }
+    set typelist {}
+    foreach l $lst {
+        lappend typelist [Fourierinfo $l type]
+    }
+    set hists [FourierHists $phase]
+    # make sure we have default limits
+    getFourierLimits $phase
+    if {[llength $hists] < 1} {
+        MyMessageBox -parent . -title "No Fourier" \
+            -message "You have not set up to compute a Fourier map for phase $phase." \
+            -icon warning
+        return
+    }
+    if {$::tcl_platform(platform) == "windows"} {
+        set map [file join $expgui(gsasexe) gsas2map.exe]
+        set fourier [file join $expgui(gsasexe) fourier.exe]
+    } else {
+        set map [file join $expgui(gsasexe) gsas2map]
+        set fourier [file join $expgui(gsasexe) fourier]
+    }
+    if {![file exists $map]} {
+        MyMessageBox -parent . -title "No Map Converter prog" \
+            -message "Error Fourier map converter program ($map) not found." \
+            -icon warning
+        return
+    }
+    if {![file exists $fourier]} {
+        MyMessageBox -parent . -title "No Fourier prog" \
+            -message "Error Fourier program ($fourier) not found." \
+            -icon warning
+        return
+    }
+    set fp [open f.in w]
+    if {[llength $typelist] > 1} {
+        puts $fp [lindex $typelist 0]
+    }
+    puts $fp "E"
+    foreach t [lrange $typelist 1 end] {
+        puts $fp "F $t"
+        puts $fp "E"
+    }
+    puts $fp "q"
+    close $fp
+    # delete any old grd files
+    foreach f [glob -nocomplain "[file root $expgui(expfile)]*.grd"] {
+        catch {file delete -force $f}
+    }
+    set deleteerror 0
+    if {[llength [glob -nocomplain "[file root $expgui(expfile)]*.grd"]] >0} {
+        MyMessageBox -parent . -title "Old grd files?" \
+            -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." \
+            -icon warning
+        set deleteerror 1
+    }
+    catch {
+        exec $fourier [file root $expgui(expfile)] >& f.out
+        exec $map [file root $expgui(expfile)] < f.in >>& f.out
+    }
+    if {[llength [glob -nocomplain "[file root $expgui(expfile)]*.grd"]] == 0} {
+        set fp [open f.out r]
+        set lines {}
+        while {[gets $fp line] >= 0} {
+            append lines $line "\n"
+        }
+        close $fp
+        MyMessageBox -parent . -title "No grd files" \
+            -message "Error: no .grd files were created. See log file below\n\n$lines" \
+            -icon error
+        return {}
+    } else {
+        catch {close $fp}
+        catch {file delete -force f.in f.out}
+        return $typelist
+    }
+}
+
+proc SetupFourierButtons {} {
+    set phase $::expgui(export_phase)
+    $::DXTL(FourCompute) config -state disabled
+    $::DXTL(AddContour) config -state disabled
+    $::DXTL(fmenu) delete 0 end
+    set ::DXTL(mtype) ""
+    set ::DXTL(mfil) ""
+    # if the Fourier is not set up; return here
+    if {[listFourier] < 1} return
+    if {[llength [FourierHists $phase]] < 1} return
+    # make sure we have default limits
+    getFourierLimits $phase
+    $::DXTL(FourCompute) config -state normal
+    # if there are no maps, return here
+    set maps [glob -nocomplain "[file root $::expgui(expfile)]*.grd"]
+    if {[llength $maps] < 1} return
+    set types {}
+    foreach fil $maps {
+        lappend types [lindex [split [file root [file tail $fil]] "_"] end]
+    }
+    $::DXTL(AddContour) config -state normal
+    set i 0
+    foreach fil $maps lbl $types {
+        if {$i == 1} {$::DXTL(fmenu) invoke 0}
+        incr i
+        $::DXTL(fmenu) add command -label $lbl \
+            -command "set DXTL(mtype) $lbl; set DXTL(mfil) $fil"
+    }
+}
+
+proc EditFourier {} {
+    error
+}
+
+proc AddContour {} {
+    error
+}
+
+proc DXTLwriteFourierCommands {} {
+    error
+    #mapread grd 10CO_DELF.grd 4
+    #mapcontour  2.000 mesh Green
+    #mapcontour  2.500 solid Blue
+}