source: branches/sandbox/export_drawxtl.tcl @ 1215

Last change on this file since 1215 was 1215, checked in by toby, 9 years ago

Split restraints & constraints; add compositional (chemical) constraint

  • Property svn:keywords set to Author Date Revision Id
File size: 21.8 KB
Line 
1# export a phase to DRAWXTL
2#
3# $Id: export_drawxtl.tcl 1215 2012-08-19 13:40:46Z toby $
4# set local variables that define the proc to execute and the menu label
5set label "export to DRAWXTL (.str) file"
6set action export_drawxtl
7set ::DXTLcolorlist "White Red Green Blue Yellow Cyan Magenta Black Orange Brown Grey Silver White"
8proc export_drawxtl {} {
9    global expmap expgui
10    # don't bother if there are no phases to write
11    if {[llength $expmap(phaselist)] == 0} {
12        MyMessageBox -parent . -title "No phases" \
13                -message "Sorry, no phases are present to write" \
14                -icon warning
15        return
16    }
17    foreach t [trace vinfo expgui(export_phase)] {
18        eval trace vdelete expgui(export_phase) $t
19    }
20     MakeExportBox .export "Export coordinates to program DRAWXTL" ""
21#           "MakeWWWHelp expgui.html export"
22
23    # trigger a quit on window delete
24    wm protocol .export WM_DELETE_WINDOW {set expgui(export_phase) 0; destroy .export }
25    set bx .export.special
26    global DXTL
27    if {[info global DXTL] == ""} {
28        set DXTL(bonds) 0
29        set DXTL(coords) 1
30        set DXTL(blackarrow) Green
31        set DXTL(redarrow) Red
32    }
33    set row 1
34    grid [label $bx.1 -text "Title:"] -column 1 -row $row -sticky e
35    grid [entry $bx.2 -textvariable DXTL(title) -width 40] \
36        -row $row -column 2 -columnspan 5 -sticky w
37    set DXTL(title) [expinfo title]
38    incr row
39    grid [checkbutton $bx.3 -text "Include coordinates in .str file" \
40              -variable DXTL(coords)] \
41        -row $row -column 1 -columnspan 5 -sticky w
42    incr row
43    set DXTL(arrowbox) $bx.4
44    grid [checkbutton $bx.4 -text "Display arrows for magnetic atoms" \
45              -variable DXTL(genarrows) -state disabled] \
46        -row $row -column 1 -columnspan 5 -sticky w
47    incr row
48    set DXTL(arrowcolorbox) $bx.4a
49    set DXTL(arrowcolorbox_row) $row
50    grid [frame $bx.4a] -sticky ew -row $DXTL(arrowcolorbox_row) \
51        -column 1 -columnspan 5 
52    grid [label $bx.4a.h -text "Arrow colors: "] -column 0 -row 1 -sticky w
53    grid [label $bx.4a.bll -text "   generated by Black operator "] -column 0 -row 2
54    eval tk_optionMenu $bx.4a.bl DXTL(blackarrow) $::DXTLcolorlist
55    grid $bx.4a.bl -column 2 -row 2
56    grid [label $bx.4a.redl -text "  generated by Red operator "] -column 0 -row 3
57    eval tk_optionMenu $bx.4a.red DXTL(redarrow) $::DXTLcolorlist
58    grid $bx.4a.red -column 2 -row 3
59    incr row
60    # is DRAWxtl installed?
61    set app {}
62    if {![catch {set fp [open [file join $::env(HOME) .drawxtlrc] r]}]} {
63        # line 12 is name of executable
64        set i 0
65        while {$i < 12} {
66            incr i
67            gets $fp appname
68        }
69        close $fp
70        set app [auto_execok $appname]
71    }
72    if {$app != ""} {
73        set show normal
74        set DXTL(app) $appname
75        set DXTL(launch) 1
76    } else {
77        set show disabled
78        set DXTL(launch) 0
79    }
80    grid [checkbutton $bx.l -text "Launch DRAWxtl" \
81              -variable DXTL(launch) -state $show] \
82        -row $row -column 1 -columnspan 5 -sticky w
83    incr row
84    grid [frame $bx.c -relief groove -bd 4] -row $row -column 0 -columnspan 5
85    grid [label $bx.c.0 -text "Range of fractional coordinates to include" \
86              -anchor center] -row 0 -column 0 -columnspan 8
87    foreach v {x y z} V {X Y Z} {
88        incr row
89        grid [label $bx.c.${v}1 -text "${V} min:"] -column 1 -row $row
90        grid [entry $bx.c.${v}2 -textvariable DXTL(${v}min) -width 4] -column 2 -row $row
91        grid [scale $bx.c.${v}3 -resolution 0.1 -variable DXTL(${v}min) \
92                  -showvalue 0 -orient h -from -2 -to 1] -column 3 -row $row
93        set DXTL(${v}min) -0.1
94        grid [label $bx.c.${v}4 -text " max:"] -column 4 -row $row
95        grid [entry $bx.c.${v}5 -textvariable DXTL(${v}max) -width 4] -column 5 -row $row
96        grid [scale $bx.c.${v}6 -resolution 0.1 -variable DXTL(${v}max) \
97                  -showvalue 0 -orient h -from 0 -to 3] -column 6 -row $row
98        set DXTL(${v}max) 1.1
99    }
100    # atom type box
101    grid [frame $bx.s -relief groove -bd 4] -row $row -column 0 -columnspan 5 -sticky nsew
102    grid [label $bx.s.0 -text "Atom representation" \
103              -anchor w] -row 0 -column 0 -sticky w
104    grid [canvas $bx.s.canvas -relief sunk -bd 2 \
105              -scrollregion {0 0 5000 500} -width 250 -height 70 \
106              -yscrollcommand "$bx.s.scroll set" ] \
107        -column 0 -row [incr row] -sticky nsew
108    grid columnconfig $bx.s 0 -weight 1
109    frame [set DXTL(lb) $bx.s.canvas.fr]
110    $bx.s.canvas create window 0 0 -anchor nw -window $DXTL(lb)
111    grid [scrollbar $bx.s.scroll \
112              -command "$bx.s.canvas yview"] -sticky ns -row $row -column 1
113    # bond box
114    incr row
115    grid [frame $bx.b -relief groove -bd 4] -row $row -column 0 -columnspan 5 -sticky ew
116    grid [frame $bx.b.0] -row 0 -column 0 -columnspan 7 -sticky ew
117    grid [label $bx.b.0.1 -text "Bond List" \
118              -anchor w] -row 0 -column 0 -sticky w
119    grid columnconfig $bx.b.0 0 -weight 1
120    grid [button $bx.b.0.b -text "Add Bond" -command DXTLaddBond \
121             ] -row 0 -column 1 -sticky e
122    grid [canvas $bx.b.canvas -relief sunk -bd 2 \
123              -scrollregion {0 0 5000 500} -width 250 -height 70 \
124              -yscrollcommand "$bx.b.scroll set" ] \
125        -column 0 -row [incr row] -sticky nsew
126    grid columnconfig $bx.b 0 -weight 1
127    frame [set DXTL(Blst) $bx.b.canvas.fr]
128    $bx.b.canvas create window 0 0 -anchor nw -window $DXTL(Blst)
129    grid [scrollbar $bx.b.scroll \
130              -command "$bx.b.canvas yview"] -sticky ns -row $row -column 1
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"
161    SetDXTLatoms
162    # this appears to be needed by OSX
163    ResizeWin .export
164
165    # Wait for the Write or Quit button to be pressed
166    tkwait window .export
167    afterputontop
168    # test for Quit
169    if {$expgui(export_phase) == 0} {return}
170
171    # now open the file and write it
172    set phase $expgui(export_phase)
173    if [catch {
174        set filnam [file rootname $expgui(expfile)]_${phase}.str
175        set fp [open $filnam w]
176        # deal with macromolecular phases
177        if {[lindex $expmap(phasetype) [expr {$phase - 1}]] == 4} {
178            MyMessageBox -parent . -title "MM phase" \
179                -message "Sorry, macromolecular phases cannot be processed" \
180                -icon warning
181            return
182        }
183        catch {unset typelist}
184        foreach atom $expmap(atomlist_$phase) {
185            set typelist([atominfo $phase $atom type]) 1
186        }
187        # title info from GSAS title & phase title
188        puts $fp "REM  created by EXPGUI from $expgui(expfile) on [clock format [clock seconds]]"
189        puts $fp "title \"$DXTL(title)\""
190        puts $fp "pack $DXTL(xmin) $DXTL(xmax) $DXTL(ymin) $DXTL(ymax) $DXTL(zmin) $DXTL(zmax)"
191        puts $fp "edges 0.02 Black"
192        puts $fp "phong 1.0 30."
193        foreach type [array names typelist] {
194            if {$DXTL(display_$type) == "sphere"} {
195                puts $fp "sphere $type $DXTL(radius_$type) $DXTL(color_$type)"
196            } elseif {$DXTL(display_$type) == "polyhedron"} {
197                puts $fp "polysz $type $DXTL(radius_$type) $DXTL(color_$type)"
198            } elseif {$DXTL(display_$type) == "ellipsoid"} {
199                puts $fp "ellipcolor $type * $DXTL(color_$type)"
200            }
201        }
202        if {$DXTL(coords)} {
203            # write out cell parameters
204            puts -nonewline $fp "cell"
205            foreach p {a b c alpha beta gamma} {
206                puts -nonewline $fp " [phaseinfo $phase $p]"
207            }
208            puts $fp ""
209            # write out GSAS spacegroup
210            puts $fp "spgp [phaseinfo $phase spacegroup]"
211            # now loop over atoms
212            foreach atom $expmap(atomlist_$phase) {
213                puts -nonewline $fp "atom [atominfo $phase $atom type] $atom "
214                foreach v {x y z} {
215                    puts -nonewline $fp "[atominfo $phase $atom $v] "
216                }
217                puts $fp ""
218               
219                set uiso [atominfo $phase $atom Uiso]
220                # are there anisotropic atoms? If so convert them to Uequiv
221                if {[atominfo $phase $atom temptype] == "A"} {
222                    puts -nonewline $fp "Uij [atominfo $phase $atom type] $atom "
223                    foreach v {U11 U22 U33 U12 U13 U23} {
224                        puts -nonewline $fp "[atominfo $phase $atom $v] "
225                    }
226                    puts $fp ""
227                }
228            }
229        } else {
230            puts $fp "import gsas [file tail $expgui(expfile)] $phase"
231        }
232        for {set i 1} {$i <= $DXTL(bonds)} {incr i} {
233            puts $fp "bond $DXTL(ba_$i) $DXTL(bb_$i) $DXTL(bw_$i) $DXTL(bmin_$i) $DXTL(bmax_$i) $DXTL(bc_$i)"
234        }
235        # list arrows, when requested
236        if {[lindex $expmap(phasetype) [expr {$phase - 1}]] != 1 && \
237                $DXTL(genarrows)} {
238            DXTLwriteArrows $fp $phase
239        }
240        DXTLwriteFourierCommands
241        puts $fp "END"
242        close $fp
243        if {$DXTL(launch)} {
244            exec $DXTL(app) $filnam &
245        }
246    } errmsg] {
247        MyMessageBox -parent . -title "Export error" \
248                -message "Export error: $errmsg" -icon warning
249    } else {
250        MyMessageBox -parent . -title "Done" \
251                -message "File [file tail $filnam] was written"
252    }
253    catch {unset DXTL}
254    foreach t [trace vinfo expgui(export_phase)] {
255        eval trace vdelete expgui(export_phase) $t
256    }
257 }
258
259# resize windows -- this appears to be needed by OSX 10.2
260proc ResizeWin {win} {
261    update
262    wm geom $win [winfo reqwidth $win]x[winfo reqheight $win]
263    # center the EXPGUI window
264    wm withdraw $win
265    set x [expr [winfo screenwidth $win]/2 - [winfo reqwidth $win]/2 ]
266    set y [expr [winfo screenheight $win]/2 - [winfo reqheight $win]/2]
267    wm geom $win +$x+$y
268    wm deiconify $win
269}
270
271
272# add atoms to atom representation list
273proc SetDXTLatoms {args} {
274    global DXTL expgui expmap
275    eval destroy [winfo children $DXTL(lb)]
276    eval destroy [winfo children $DXTL(Blst)]
277    set DXTL(bonds) 0
278    if {$expgui(export_phase) == 0} {return}
279    set phase $expgui(export_phase)
280    if {[lindex $expmap(phasetype) [expr {$phase - 1}]] == 4} {
281        MyMessageBox -parent . -title "MM phase" \
282            -message "Sorry, macromolecular phases cannot be processed" \
283            -icon warning
284        return
285    }
286    if {[lindex $expmap(phasetype) [expr {$phase - 1}]] == 1} {
287        set DXTL(genarrows) 0
288        $DXTL(arrowbox) configure -state disabled
289        grid forget $DXTL(arrowcolorbox) 
290    } else {
291        set DXTL(genarrows) 1
292        $DXTL(arrowbox) configure -state normal
293        grid $DXTL(arrowcolorbox) -sticky ew -row $DXTL(arrowcolorbox_row) \
294            -column 1 -columnspan 5
295    }
296    catch {unset typelist}
297    set DXTL(title)  [phaseinfo $phase name]
298    foreach atom $expmap(atomlist_$phase) {
299        set typelist([atominfo $phase $atom type]) 1
300    }
301    set DXTL(typelist) [array names typelist]
302    set row 0
303    grid [label $DXTL(lb).l$row -text "type " -bg yellow\
304             ] -column 0 -row $row  -sticky ew
305    grid [label $DXTL(lb).d$row -text " representation " -bg yellow
306         ] -column 1 -row $row -sticky ew
307    grid [label $DXTL(lb).e$row -text " radius " -bg yellow\
308             ] -column 2 -row $row -sticky ew
309    grid [label $DXTL(lb).c$row -text " color " -bg yellow\
310             ] -column 3 -row $row -sticky ew
311    foreach type [array names typelist] {
312        incr row
313        grid [label $DXTL(lb).l$row -text $type] -column 0 -row $row
314        tk_optionMenu $DXTL(lb).d$row DXTL(display_$type) sphere polyhedron ellipsoid none
315        grid $DXTL(lb).d$row -column 1 -row $row
316        grid [entry $DXTL(lb).e$row -textvariable DXTL(radius_$type) \
317                -width 5] -column 2 -row $row
318        eval tk_optionMenu $DXTL(lb).c$row DXTL(color_$type) $::DXTLcolorlist
319        grid $DXTL(lb).c$row -column 3 -row $row
320        set DXTL(display_$type) sphere
321        set DXTL(radius_$type) 0.2
322        set DXTL(color_$type) [lindex $::DXTLcolorlist $row]
323    }
324    # Resize the list
325    update
326    set sizes [grid bbox $DXTL(lb)]
327    [winfo parent $DXTL(lb)] config -scrollregion $sizes \
328        -width [lindex $sizes 2]
329    set sizes [grid bbox $DXTL(Blst)]
330    [winfo parent $DXTL(Blst)] config -scrollregion $sizes \
331        -width [lindex $sizes 2]
332    wm geom [winfo toplevel $DXTL(Blst)] {}
333}
334
335# add bonds to bond list
336proc DXTLaddBond {} {
337    global DXTL
338    if {$DXTL(bonds) == 0} {
339        # insert header
340        set row 0
341        grid [label $DXTL(Blst).a$row -text "from " -bg yellow\
342                 ] -column 1 -row $row  -sticky ew
343        grid [label $DXTL(Blst).b$row -text " to " -bg yellow\
344                 ] -column 2 -row $row  -sticky ew
345        grid [label $DXTL(Blst).c$row -text " width " -bg yellow\
346                 ] -column 3 -row $row  -sticky ew
347        grid [label $DXTL(Blst).d$row -text " min " -bg yellow\
348             ] -column 4 -row $row  -sticky ew
349        grid [label $DXTL(Blst).e$row -text " max " -bg yellow\
350                 ] -column 5 -row $row  -sticky ew
351        grid [label $DXTL(Blst).f$row -text " color " -bg yellow\
352                 ] -column 6 -row $row  -sticky ew
353    }
354    set row [incr DXTL(bonds)]
355    eval tk_optionMenu $DXTL(Blst).ta$row DXTL(ba_$row) $DXTL(typelist)
356    grid $DXTL(Blst).ta$row -column 1 -row $row
357    eval tk_optionMenu $DXTL(Blst).tb$row DXTL(bb_$row) $DXTL(typelist)
358    grid $DXTL(Blst).tb$row -column 2 -row $row
359    grid [entry $DXTL(Blst).w$row -textvariable DXTL(bw_$row) \
360              -width 5] -column 3 -row $row
361    grid [entry $DXTL(Blst).mi$row -textvariable DXTL(bmin_$row) \
362              -width 5] -column 4 -row $row
363    grid [entry $DXTL(Blst).mx$row -textvariable DXTL(bmax_$row) \
364              -width 5] -column 5 -row $row
365    eval tk_optionMenu $DXTL(Blst).c$row DXTL(bc_$row) $::DXTLcolorlist
366    grid $DXTL(Blst).c$row -column 6 -row $row
367    set DXTL(bw_$row) 0.02
368    set DXTL(bmin_$row) 1.0
369    set DXTL(bmax_$row) 2.0
370    set DXTL(bc_$row) [lindex $::DXTLcolorlist $row]
371    # Resize the list
372    update
373    set sizes [grid bbox $DXTL(Blst)]
374    [winfo parent $DXTL(Blst)] config -scrollregion $sizes \
375        -width [lindex $sizes 2]
376}
377
378proc DXTLwriteArrows {out phase} {
379    global expgui expmap DXTL
380    set fp [open geom.in w]
381    puts $fp "N"
382    puts $fp "M"
383    if {[llength $expmap(phaselist)] > 1} {
384        puts $fp "$phase"
385    }
386    puts $fp "N"
387    puts $fp "X"
388    close $fp
389    catch {
390        if {$::tcl_platform(platform) == "windows"} {
391            exec [file join $expgui(gsasexe) geometry.exe] \
392                [file root $expgui(expfile)] < geom.in >& geom.out
393        } else {
394            exec [file join $expgui(gsasexe) geometry] \
395                [file root $expgui(expfile)] < geom.in >& geom.out
396        }
397        set fp [open geom.out r]
398        while {[gets $fp line] >= 0} {
399            if {[string match "*Geometry*,L,N,*" $line]} {
400                MyMessageBox -parent . -title "Old GSAS" \
401                    -message "Old GEOMETRY program: You are using an old version of GSAS that cannot export magnetic vectors. Upgrade GSAS to generate arrows." -icon warning
402                break
403            }
404            if {[string match "*name*elem*x *y *z*x *y *z*" $line]} {break}
405        }
406        set i 0
407        while {[gets $fp line] >= 0} {
408            if {[string match "*Enter Geometry option*" $line]} {break}
409            incr i
410            if {$i == 2} {
411                set name [string trim [string range $line 5 12]]
412                set tail [string trim [string range $line 22 end]]
413                set pos [lrange $tail 0 2]
414                set spin [lindex $tail end]
415            } elseif {$i == 5} {
416                set vec [string trim [string range $line 22 end]]
417                if {[catch {set count($name)}]} {set count($name) 0}
418                catch {
419                    set k ?
420                    incr count($name)
421                    set k $count($name)
422                }
423                puts $out "rem spin for atom $name # $k ($spin)"
424                if {$spin == "Red"} {
425                    puts $out "arrow $pos     $vec    1. 0.15 $DXTL(redarrow)"
426                } else {
427                    puts $out "arrow $pos     $vec    1. 0.15 $DXTL(blackarrow)"
428                }
429            } elseif {$i == 6} {
430                set i 1
431            }
432        }
433    }
434    catch {close $fp}
435    catch {file delete -force geom.in geom.out}
436    puts $out "mag_trans 1. 0 0  0 1. 0  0 0 1."
437}
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    global DXTL
562    # if {$DXTL(bonds) == 0} {
563    #     # insert header
564    #     set row 0
565    #     grid [label $DXTL(Blst).a$row -text "from " -bg yellow\
566    #            ] -column 1 -row $row  -sticky ew
567    #     grid [label $DXTL(Blst).b$row -text " to " -bg yellow\
568    #            ] -column 2 -row $row  -sticky ew
569    #     grid [label $DXTL(Blst).c$row -text " width " -bg yellow\
570    #            ] -column 3 -row $row  -sticky ew
571    #     grid [label $DXTL(Blst).d$row -text " min " -bg yellow\
572    #          ] -column 4 -row $row  -sticky ew
573    #     grid [label $DXTL(Blst).e$row -text " max " -bg yellow\
574    #            ] -column 5 -row $row  -sticky ew
575    #     grid [label $DXTL(Blst).f$row -text " color " -bg yellow\
576    #            ] -column 6 -row $row  -sticky ew
577    # }
578    # set row [incr DXTL(bonds)]
579    # eval tk_optionMenu $DXTL(Blst).ta$row DXTL(ba_$row) $DXTL(typelist)
580    # grid $DXTL(Blst).ta$row -column 1 -row $row
581    # eval tk_optionMenu $DXTL(Blst).tb$row DXTL(bb_$row) $DXTL(typelist)
582    # grid $DXTL(Blst).tb$row -column 2 -row $row
583    # grid [entry $DXTL(Blst).w$row -textvariable DXTL(bw_$row) \
584    #           -width 5] -column 3 -row $row
585    # grid [entry $DXTL(Blst).mi$row -textvariable DXTL(bmin_$row) \
586    #           -width 5] -column 4 -row $row
587    # grid [entry $DXTL(Blst).mx$row -textvariable DXTL(bmax_$row) \
588    #           -width 5] -column 5 -row $row
589    # eval tk_optionMenu $DXTL(Blst).c$row DXTL(bc_$row) $::DXTLcolorlist
590    # grid $DXTL(Blst).c$row -column 6 -row $row
591    # set DXTL(bw_$row) 0.02
592    # set DXTL(bmin_$row) 1.0
593    # set DXTL(bmax_$row) 2.0
594    # set DXTL(bc_$row) [lindex $::DXTLcolorlist $row]
595    # # Resize the list
596    # update
597    # set sizes [grid bbox $DXTL(Blst)]
598    # [winfo parent $DXTL(Blst)] config -scrollregion $sizes \
599    #     -width [lindex $sizes 2]
600    error
601}
602
603proc DXTLwriteFourierCommands {} {
604    error
605    #mapread grd 10CO_DELF.grd 4
606    #mapcontour  2.000 mesh Green
607    #mapcontour  2.500 solid Blue
608}
Note: See TracBrowser for help on using the repository browser.