source: trunk/widplt @ 111

Last change on this file since 111 was 111, checked in by toby, 11 years ago

# on 1999/10/11 19:46:43, toby did:
Define expgui(debug)

  • Property rcs:author set to toby
  • Property rcs:date set to 1999/10/11 19:46:43
  • Property rcs:lines set to +6 -2
  • Property rcs:rev set to 1.5
  • Property rcs:state set to Exp
  • Property svn:keywords set to Author Date Revision Id
File size: 24.5 KB
Line 
1#!/usr/local/bin/wish
2# $Id: widplt 111 2009-12-04 23:00:35Z toby $
3set Revision {$Revision: 111 $ $Date: 2009-12-04 23:00:35 +0000 (Fri, 04 Dec 2009) $}
4bind all <Control-KeyPress-c> {destroy .}
5set expnam [lindex $argv 0]
6if {$expnam != ""} {
7    if {[string toupper [file extension $expnam]] != ".EXP"} {
8        append expnam ".EXP"
9    }
10}
11if [catch {package require BLT} errmsg] {
12    tk_dialog .err "BLT Error" "Error -- Unable to load the BLT package" \
13            error 0 Quit
14    destroy .
15}
16
17# handle Tcl/Tk v8+ where BLT is in a namespace
18#  use the command so that it is loaded
19catch {blt::graph}
20catch {
21    namespace import blt::graph
22    namespace import blt::vector
23}
24# old versions of blt don't report a version number
25if [catch {set blt_version}] {set blt_version 0}
26
27set expgui(debug) 0
28catch {if $env(DEBUG) {set expgui(debug) 1}}
29#set expgui(debug) 1
30
31proc waitmsg {message} {
32    set w .wait
33    # kill any window/frame with this name
34    catch {destroy $w}
35    pack [frame $w]
36    frame $w.bot -relief raised -bd 1
37    pack $w.bot -side bottom -fill both
38    frame $w.top -relief raised -bd 1
39    pack $w.top -side top -fill both -expand 1
40    label $w.msg -justify left -text $message -wrap 3i
41    catch {$w.msg configure -font \
42                -Adobe-Times-Medium-R-Normal--*-180-*-*-*-*-*-*
43    }
44    pack $w.msg -in $w.top -side right -expand 1 -fill both -padx 3m -pady 3m
45    label $w.bitmap -bitmap info
46    pack $w.bitmap -in $w.top -side left -padx 3m -pady 3m
47    update
48}
49
50proc donewait {} {
51    catch {destroy .wait}
52    update
53}
54
55if {$expnam != ""} {waitmsg "Loading $expnam, Please wait"}
56
57# get profile information out from a EXP file
58proc getprofiles {expnam} {
59    global datalist wave XY UVWP lblarr ttrange
60
61    if [expload $expnam] {
62        tk_dialog .err "EXP Error" "Error -- Unable to read $expnam" \
63                error 0 OK
64        return
65    }
66    mapexp
67
68    global expmap
69    foreach hist $expmap(powderlist) {
70        # wavelength
71        set lambda1 [histinfo $hist lam1]
72        # data range
73        set drange [readexp "HST  $hist TRNGE"]
74        foreach phase $expmap(phaselist_$hist) {
75            set ptype [hapinfo $hist $phase proftype]
76            set pterms  [hapinfo $hist $phase profterms]
77            set key "H${hist}P${phase}"
78            # make sure the key is not present already
79            if {[lsearch $datalist $key] == -1} {
80                lappend datalist $key
81            }
82            set lblarr($key) "Histogram $hist Phase $phase"
83            set wave($key) $lambda1
84            set ttrange($key) $drange
85            if {$ptype == 1} {
86                set UVWP($key) "[hapinfo $hist $phase pterm1] [hapinfo $hist $phase pterm2] [hapinfo $hist $phase pterm3] 0"
87                set XY($key) {0 0}
88            } elseif {$ptype == 2} {
89                set UVWP($key) "[hapinfo $hist $phase pterm1] [hapinfo $hist $phase pterm2] [hapinfo $hist $phase pterm3] [hapinfo $hist $phase pterm9]"
90                set XY($key) "[hapinfo $hist $phase pterm4] [hapinfo $hist $phase pterm5]"
91            } elseif {$ptype == 3 || $ptype == 4} {
92                set UVWP($key) "[hapinfo $hist $phase pterm1] [hapinfo $hist $phase pterm2] [hapinfo $hist $phase pterm3] [hapinfo $hist $phase pterm4]"
93                set XY($key) "[hapinfo $hist $phase pterm5] [hapinfo $hist $phase pterm6]"
94            }
95        }
96    }
97}
98
99proc makepostscriptout {} {
100    global graph box
101    if !$graph(printout) {
102        set out [open "| $graph(outcmd) >& widplt.msg" w]
103        catch {
104            puts $out [$box postscript output -landscape 1 \
105                -decorations no -height 7.i -width 9.5i]
106            close $out
107        } msg
108        catch {
109            set out [open widplt.msg r]
110            if {$msg != ""} {append msg "\n"}
111            append msg [read $out]
112            close $out
113            file delete widplt.msg
114        }
115        if {$msg != ""} {
116            tk_dialog .msg "file created" \
117                    "Postscript file processed with command \
118                    $graph(outcmd). Result: $msg" "" 0 OK
119        } else {
120            tk_dialog .msg "file created" \
121                    "Postscript file processed with command \
122                    $graph(outcmd)" "" 0 OK
123        }
124    } else {
125        $box postscript output $graph(outname) -landscape 1 \
126                -decorations no -height 7.i -width 9.5i   
127        tk_dialog .msg "file created" \
128                "Postscript file $graph(outname) created" "" 0 OK
129    }
130}
131
132proc setprintopt {page} {
133    global graph
134    if $graph(printout) {
135        $page.4.1 config -fg black
136        $page.4.2 config -fg black -state normal
137        $page.6.1 config -fg #888
138        $page.6.2 config -fg #888 -state disabled
139    } else {
140        $page.4.1 config -fg #888
141        $page.4.2 config -fg #888 -state disabled
142        $page.6.1 config -fg black
143        $page.6.2 config -fg black -state normal
144    }
145}
146
147proc seteqwave {top} {
148    global graph
149    set box .wave
150    catch {destroy $box}
151    toplevel $box
152    focus $box
153    grab $box
154    pack [frame $box.1] -side top
155    pack [label $box.1.a -text "Equivalent wavelength:"] -side top
156    pack [entry $box.1.b -textvariable graph(equivwave)] -side top
157    pack [frame $box.2] -side top
158    pack [button $box.2.c -text Clear -command "set graph(equivwave) {}; destroy $box"]
159    pack [button $box.2.u -text Use -command "destroy $box"]
160    tkwait window $box
161    plotdata $top
162}
163
164proc setpostscriptout {} {
165    global graph tcl_platform
166    set box .out
167    catch {destroy $box}
168    toplevel $box
169    focus $box
170    grab $box
171    pack [frame $box.4] -side top -anchor w -fill x
172    pack [checkbutton $box.4.a -text "Write PostScript files" \
173            -variable graph(printout) -offvalue 0 -onvalue 1 \
174            -command "setprintopt $box"] -side left -anchor w
175    pack [entry $box.4.2 -textvariable graph(outname)] -side right -anchor w
176    pack [label $box.4.1 -text "PostScript file name:"] -side right -anchor w
177    pack [frame $box.6] -side top -anchor w -fill x
178    pack [checkbutton $box.6.a -text "Print PostScript files" \
179            -variable graph(printout) -offvalue 1 -onvalue 0 \
180            -command "setprintopt $box" ] -side left -anchor w
181    pack [entry $box.6.2 -textvariable graph(outcmd)] -side right -anchor w
182    pack [label $box.6.1 -text "Command to print files:"] -side right -anchor w
183
184    pack [button $box.a -text "Close" -command "destroy $box"] -side top   
185    if {$tcl_platform(platform) == "windows"} {
186        set graph(printout) 1
187        $box.4.a config -state disabled
188        $box.6.a config -fg #888 -state disabled
189    }
190    setprintopt $box
191}
192
193proc aboutwidplot {} {
194    global Revision
195    tk_dialog .warn About "
196GSAS\n\
197A. C. Larson and\n R. B. Von Dreele,\n LANSCE, Los Alamos\n\n\
198WIDPLT\nB. Toby, NIST\nNot subject to copyright\n\n\
199$Revision\n\
200" {} 0 OK
201}
202
203proc nextcolor {var} {
204    set num [uplevel "incr $var"]
205    return [lindex {red green blue cyan magenta yellow} [expr $num % 6]]
206}
207
208proc newmenu {} {
209    global newmenu datanum
210    incr datanum
211    set base .new
212    catch {destroy $base}
213    toplevel $base
214    focus $base
215    grab $base
216    wm title $base {Enter a new profile}
217    label $base.label#7 -text Gaussian
218    label $base.label#8 -text Lorentz
219    label $base.label#1 -text U
220    label $base.label#2 -text V
221    label $base.label#3 -text W
222    label $base.label#4 -text P
223    label $base.label#5 -text X
224    label $base.label#6 -text Y
225    entry $base.entry#1 -textvariable newmenu(U) -width 8
226    entry $base.entry#2 -textvariable newmenu(V) -width 8
227    entry $base.entry#3 -textvariable newmenu(W) -width 8
228    entry $base.entry#4 -textvariable newmenu(P) -width 8
229    entry $base.entry#5 -textvariable newmenu(X) -width 8
230    entry $base.entry#6 -textvariable newmenu(Y) -width 8
231
232    label $base.label#9 -text label
233    entry $base.entry#7 -textvariable newmenu(label)
234   
235    label $base.label#11 -text {2Theta Min}
236    entry $base.entry#9 -textvariable newmenu(min) -width 6
237    label $base.label#12 -text {2Theta Max}
238    entry $base.entry#10 -textvariable newmenu(max) -width 6
239   
240    label $base.label#13 -text Wavelength
241
242    entry $base.entry#11 -textvariable newmenu(wave) -width 8
243   
244    button $base.button#1 -text Add -command "addopt; destroy $base"
245    button $base.button#2 -text Quit -command "destroy $base"
246   
247    # Geometry management
248
249    grid $base.label#7 -in $base        -row 2 -column 1  -columnspan 4
250    grid $base.label#8 -in $base        -row 2 -column 6  -columnspan 2
251    grid $base.label#1 -in $base        -row 3 -column 1
252    grid $base.label#2 -in $base        -row 3 -column 2
253    grid $base.label#3 -in $base        -row 3 -column 3
254    grid $base.label#4 -in $base        -row 3 -column 4
255    grid $base.label#5 -in $base        -row 3 -column 6
256    grid $base.label#6 -in $base        -row 3 -column 7
257    grid $base.entry#1 -in $base        -row 4 -column 1
258    grid $base.entry#2 -in $base        -row 4 -column 2
259    grid $base.entry#3 -in $base        -row 4 -column 3
260    grid $base.entry#4 -in $base        -row 4 -column 4
261    grid $base.entry#5 -in $base        -row 4 -column 6
262    grid $base.entry#6 -in $base        -row 4 -column 7
263    grid $base.label#9 -in $base        -row 5 -column 1
264    grid $base.entry#7 -in $base        -row 5 -column 2  -columnspan 3
265    grid $base.label#13 -in $base       -row 5 -column 5  -columnspan 2
266    grid $base.entry#11 -in $base       -row 5 -column 7
267    grid $base.label#11 -in $base       -row 6 -column 1
268    grid $base.entry#9 -in $base        -row 6 -column 2
269    grid $base.label#12 -in $base       -row 6 -column 3
270    grid $base.entry#10 -in $base       -row 6 -column 4
271    grid $base.button#1 -in $base       -row 6 -column 6
272    grid $base.button#2 -in $base       -row 6 -column 7
273   
274    # Resize behavior management
275
276    grid rowconfigure $base 2 -weight 1 -minsize 17
277    grid rowconfigure $base 3 -weight 0 -minsize 19
278    grid rowconfigure $base 4 -weight 0 -minsize 30
279    grid rowconfigure $base 5 -weight 0 -minsize 30
280    grid rowconfigure $base 6 -weight 0 -minsize 30
281    grid columnconfigure $base 1 -weight 0 -minsize 26
282    grid columnconfigure $base 2 -weight 0 -minsize 30
283    grid columnconfigure $base 3 -weight 0 -minsize 30
284    grid columnconfigure $base 4 -weight 0 -minsize 65
285    grid columnconfigure $base 5 -weight 1 -minsize 26
286    grid columnconfigure $base 6 -weight 0 -minsize 30
287    grid columnconfigure $base 7 -weight 0 -minsize 30
288    set newmenu(U) 0
289    set newmenu(V) 0
290    set newmenu(W) 0
291    set newmenu(P) 0
292    set newmenu(X) 0
293    set newmenu(Y) 0
294    set newmenu(min) 5
295    set newmenu(max) 100
296    set newmenu(label) "Curve #$datanum"
297    set newmenu(wave) 1.5418
298}
299
300proc addopt {} {
301    global newmenu datanum lblarr display UVWP XY datalist ttrange wave
302    set key new$datanum
303    set UVWP($key) [list $newmenu(U) $newmenu(V) $newmenu(W) $newmenu(P)]
304    set XY($key) [list $newmenu(X) $newmenu(Y)]
305    set lblarr($key) $newmenu(label)
306    set ttrange($key) "$newmenu(min) $newmenu(max)"
307    set wave($key) $newmenu(wave)
308    lappend datalist $key
309    .a.plot.menu add checkbutton -label $lblarr($key) \
310            -command {plotdata $box} -variable display($key)
311}
312
313proc editmenu {} {
314    global newmenu datalist lblarr
315    set base .edit
316    catch {destroy $base}
317    toplevel $base
318    focus $base
319    grab $base
320    wm title $base {Edit a profile}
321    label $base.label#7 -text Gaussian
322    label $base.label#8 -text Lorentz
323    label $base.label#1 -text U
324    label $base.label#2 -text V
325    label $base.label#3 -text W
326    label $base.label#4 -text P
327    label $base.label#5 -text X
328    label $base.label#6 -text Y
329    entry $base.entry#1 -textvariable newmenu(U) -width 8
330    entry $base.entry#2 -textvariable newmenu(V) -width 8
331    entry $base.entry#3 -textvariable newmenu(W) -width 8
332    entry $base.entry#4 -textvariable newmenu(P) -width 8
333    entry $base.entry#5 -textvariable newmenu(X) -width 8
334    entry $base.entry#6 -textvariable newmenu(Y) -width 8
335
336    label $base.label#9 -text {Select an option}
337    set llist {}
338    foreach item $datalist {lappend llist $lblarr($item)}
339    eval tk_optionMenu $base.entry#7 newmenu(opt) $llist
340
341    label $base.label#11 -text {2Theta Min}
342    entry $base.entry#9 -textvariable newmenu(min) -width 6
343    label $base.label#12 -text {2Theta Max}
344    entry $base.entry#10 -textvariable newmenu(max) -width 6
345   
346    label $base.label#13 -text Wavelength
347
348    entry $base.entry#11 -textvariable newmenu(wave) -width 8
349
350    button $base.button#1 -text Save -command "saveopt"
351    button $base.button#2 -text Quit -command "destroy $base"
352   
353    # Geometry management
354
355    grid $base.label#9 -in $base        -row 1 -column 1  -columnspan 2 \
356            -sticky e
357    grid $base.entry#7 -in $base        -row 1 -column 3  -columnspan 3 \
358            -sticky w
359    grid $base.label#7 -in $base        -row 2 -column 1  -columnspan 4
360    grid $base.label#8 -in $base        -row 2 -column 6  -columnspan 2
361    grid $base.label#1 -in $base        -row 3 -column 1
362    grid $base.label#2 -in $base        -row 3 -column 2
363    grid $base.label#3 -in $base        -row 3 -column 3
364    grid $base.label#4 -in $base        -row 3 -column 4
365    grid $base.label#5 -in $base        -row 3 -column 6
366    grid $base.label#6 -in $base        -row 3 -column 7
367    grid $base.entry#1 -in $base        -row 4 -column 1
368    grid $base.entry#2 -in $base        -row 4 -column 2
369    grid $base.entry#3 -in $base        -row 4 -column 3
370    grid $base.entry#4 -in $base        -row 4 -column 4
371    grid $base.entry#5 -in $base        -row 4 -column 6
372    grid $base.entry#6 -in $base        -row 4 -column 7
373    grid $base.label#13 -in $base       -row 5 -column 5  -columnspan 2
374    grid $base.entry#11 -in $base       -row 5 -column 7
375    grid $base.label#11 -in $base       -row 6 -column 1
376    grid $base.entry#9 -in $base        -row 6 -column 2
377    grid $base.label#12 -in $base       -row 6 -column 3
378    grid $base.entry#10 -in $base       -row 6 -column 4
379    grid $base.button#1 -in $base       -row 6 -column 6
380    grid $base.button#2 -in $base       -row 6 -column 7
381
382    # Resize behavior management
383   
384    grid rowconfigure $base 1 -weight 0 -minsize 30
385    grid rowconfigure $base 2 -weight 1 -minsize 17
386    grid rowconfigure $base 3 -weight 0 -minsize 19
387    grid rowconfigure $base 4 -weight 0 -minsize 30
388    grid rowconfigure $base 5 -weight 0 -minsize 30
389    grid rowconfigure $base 6 -weight 0 -minsize 30
390    grid columnconfigure $base 1 -weight 0 -minsize 26
391    grid columnconfigure $base 2 -weight 0 -minsize 30
392    grid columnconfigure $base 3 -weight 0 -minsize 30
393    grid columnconfigure $base 4 -weight 0 -minsize 65
394    grid columnconfigure $base 5 -weight 1 -minsize 26
395    grid columnconfigure $base 6 -weight 0 -minsize 30
396    grid columnconfigure $base 7 -weight 0 -minsize 30
397    set newmenu(U) {}
398    set newmenu(V) {}
399    set newmenu(W) {}
400    set newmenu(P) {}
401    set newmenu(X) {}
402    set newmenu(Y) {}
403    set newmenu(min) {}
404    set newmenu(max) {}
405    set newmenu(label) {}
406    set newmenu(wave) {}
407    set newmenu(opt) {}
408}
409
410proc saveopt {} {
411    global newmenu datanum lblarr display UVWP XY datalist ttrange wave box
412    set key {}
413    foreach item $datalist {
414        if {$lblarr($item) == $newmenu(opt)} {set key $item; break}
415    }
416    if {$key == ""} return
417    set UVWP($key) [list $newmenu(U) $newmenu(V) $newmenu(W) $newmenu(P)]
418    set XY($key) [list $newmenu(X) $newmenu(Y)]
419    set ttrange($key) "$newmenu(min) $newmenu(max)"
420    set wave($key) $newmenu(wave)
421    plotdata $box
422}
423
424proc loadopt {a1 a2 a3} {
425    global newmenu lblarr display UVWP XY datalist ttrange newmenu wave
426    set key {}
427    foreach item $datalist {
428        if {$lblarr($item) == $newmenu(opt)} {set key $item; break}
429    }
430    if {$key == ""} return
431    set newmenu(U) [lindex $UVWP($key) 0]
432    set newmenu(V) [lindex $UVWP($key) 1]
433    set newmenu(W) [lindex $UVWP($key) 2]
434    set newmenu(P) [lindex $UVWP($key) 3]
435    set newmenu(X) [lindex $XY($key) 0]
436    set newmenu(Y) [lindex $XY($key) 1]
437    set newmenu(min) [lindex $ttrange($key) 0]
438    set newmenu(max) [lindex $ttrange($key) 1]
439    set newmenu(wave) $wave($key)
440}
441
442proc plotdata {top} {
443    global UVWP XY wave lblarr datalist display \
444            graph ttrange
445    if {$graph(plotunits) == "d"} {
446        $top xaxis configure -title "d (A)"
447    } elseif {$graph(plotunits) == "q"} {
448        $top xaxis configure -title "Q (A-1)"
449    } elseif {$graph(equivwave) == ""} {
450        $top xaxis configure -title "2Theta"
451    } else {
452        $top xaxis configure -title "2Theta @ $graph(equivwave)"
453    }
454    $top yaxis configure -min 0
455    $top xaxis configure -min 0
456    # delete all graphs
457    eval $top element delete [$top element names]
458    set num -1
459    foreach item $datalist {
460        if {$display($item)} {
461            if {[expr [lindex $XY($item) 0] + [lindex $XY($item) 1]] != 0} {
462                set lflag 1
463            } else {
464                set lflag 0
465            }
466            set ttlist {}
467            set fwhmlist {}
468            set lfwhmlist {}
469            set tfwhmlist {}
470            # loop over two-theta
471            for     {set tt [lindex $ttrange($item) 0]} \
472                    {$tt <= [lindex $ttrange($item) 1]} \
473                    {set tt [expr $tt + 4]} {
474                set lfwhm 0
475                catch {
476                    if {$graph(plotunits) == "d"} {
477                        lappend ttlist [tt2d $wave($item) $tt ]
478                        set gfwhm [deltad $wave($item) $tt \
479                                [eval FWHM $tt $UVWP($item)]]
480                        lappend fwhmlist $gfwhm
481                        if $lflag {
482                            set lfwhm [deltad $wave($item) $tt \
483                                    [eval LFWHM $tt $XY($item)]]
484                            lappend lfwhmlist $lfwhm
485                        }
486                    } elseif {$graph(plotunits) == "q"} {
487                        lappend ttlist [tt2Q $wave($item) $tt ]
488                        set gfwhm [deltaQ $wave($item) $tt \
489                                [eval FWHM $tt $UVWP($item)]]
490                        lappend fwhmlist $gfwhm
491                        if $lflag {
492                            set lfwhm [deltaQ $wave($item) $tt \
493                                    [eval LFWHM $tt $XY($item)]]
494                            lappend lfwhmlist $lfwhm
495                        }
496                    } elseif {$graph(equivwave) == ""} {
497                        lappend ttlist $tt
498                        set gfwhm [eval FWHM $tt $UVWP($item)]
499                        lappend fwhmlist $gfwhm
500                        if $lflag {
501                            set lfwhm [eval LFWHM $tt $XY($item)]
502                            lappend lfwhmlist $lfwhm
503                        }
504                    } else {
505                        set tteq [ttequiv $wave($item) $tt $graph(equivwave)]
506                        if {$tteq != ""} {
507                            lappend ttlist $tteq
508                            set gfwhm [delta2teq $wave($item) $tt \
509                                    [eval FWHM $tt $UVWP($item)] $graph(equivwave)]
510                            lappend fwhmlist $gfwhm
511                            if $lflag {
512                                set lfwhm [delta2teq $wave($item) $tt \
513                                        [eval LFWHM $tt $XY($item)] $graph(equivwave)]
514                                lappend lfwhmlist $lfwhm
515                            }
516                        }
517                    }
518                    # assume FWHM add as square roots
519                    lappend tfwhmlist \
520                            [expr sqrt($gfwhm*$gfwhm + $lfwhm*$lfwhm)]
521                }
522            }
523            if $lflag {
524                catch {
525                    $top element create ${item}G -label "$lblarr($item) G"
526                }
527                $top element config ${item}G \
528                    -xdata $ttlist -ydata $fwhmlist -linewidth 3 \
529                    -color [nextcolor num]
530                catch {
531                    $top element create ${item}L -label "$lblarr($item) L"
532                }
533                $top element config ${item}L \
534                        -xdata $ttlist -ydata $lfwhmlist -linewidth 3 \
535                        -color [nextcolor num]
536            }
537            catch {
538                $top element create $item -label $lblarr($item)
539            }
540            $top element config $item \
541                    -xdata $ttlist -ydata $tfwhmlist -linewidth 3 \
542                    -color [nextcolor num]
543        }
544    }
545}
546
547# save some of the global options in ~/.gsas_config
548proc SaveOptions {} {
549    global graph
550    set fp [open [file join ~ .gsas_config] a]
551    puts $fp "set graph(legend) $graph(legend)"
552    puts $fp "set graph(printout) $graph(printout)"
553    puts $fp "set graph(outname) $graph(outname)"
554    puts $fp "set graph(outcmd) $graph(outcmd)"
555    puts $fp "set graph(plotunits) $graph(plotunits)"
556    puts $fp "set graph(equivwave) $graph(equivwave)"
557    close $fp
558}
559#-------------------------------------------------------------------------
560# converts 2theta(deg) to Q (A-1)
561proc tt2Q {lambda twotheta} {
562    set pi 3.14159
563    set torad [expr $pi / 360.]
564    return [expr 4 * $pi / ($lambda) * sin (($twotheta) * $torad)]
565}
566
567# converts Q (A-1) to 2theta(deg)
568proc Q2tt {lambda Q} {
569    set pi 3.14159
570    set todeg [expr 360. / $pi]
571    set asinarg [expr ($lambda) * $Q * 0.25 / $pi]
572    if {$asinarg <= 1} {
573        return [expr $todeg * asin ($asinarg)]
574    }
575    return {}
576}
577
578# converts a FWHM in 2theta(deg) to a FWHM in Q (A-1)
579proc deltaQ {lambda twotheta FWHM} {
580    return [expr [tt2Q $lambda $twotheta+($FWHM/2.)] - \
581                 [tt2Q $lambda $twotheta-($FWHM/2.)] ]
582}
583
584# converts 2theta(deg) to d (A)
585proc tt2d {lambda twotheta} {
586    set pi 3.14159
587    set torad [expr $pi / 360.]
588    return [expr 0.5 * ($lambda) / sin (($twotheta) * $torad)]
589}
590
591# converts d (A) to 2theta(deg)
592proc d2tt {lambda d} {
593    set pi 3.14159
594    set todeg [expr 360. / $pi]
595    set asinarg [expr ($lambda) * 0.5 / $d]
596    if {$asinarg <= 1} {
597        return [expr $todeg * asin ($asinarg)]
598    }
599    return {}
600}
601
602# converts a FWHM in 2theta(deg) to a FWHM in Q (A-1)
603proc deltad {lambda twotheta FWHM} {
604    return [expr [tt2d $lambda $twotheta-($FWHM/2.)] - \
605                 [tt2d $lambda $twotheta+($FWHM/2.)] ]
606}
607
608# computes an equivalent 2theta at a different wavelength
609proc ttequiv {lambda twotheta lambda_eq} {
610    return [Q2tt $lambda_eq [tt2Q $lambda $twotheta]]
611}
612
613# converts a FWHM in 2theta(deg) to a FWHM at in 2theta
614# at a different wavelength
615proc delta2teq {lambda twotheta FWHM lambda_eq} {
616    return [expr [Q2tt $lambda_eq [tt2Q $lambda $twotheta+($FWHM/2.)]] - \
617                 [Q2tt $lambda_eq [tt2Q $lambda $twotheta-($FWHM/2.)]] ]
618}
619
620proc FWHM {tt U V W P} {
621    set pi 3.14159
622    set torad [expr $pi / 360.]
623    # tan theta
624    set tantt [expr tan($tt * $torad ) ]
625    set costt [expr cos($tt * $torad ) ]
626    return [expr sqrt \
627            (8.* log(2) * ($U * $tantt * $tantt + $V * $tantt + $W \
628            + $P / ($costt * $costt))) / 100.]
629}
630proc LFWHM {tt X Y} {
631    set pi 3.14159
632    set torad [expr $pi / 360.]
633    # tan theta
634    set tantt [expr tan($tt * $torad ) ]
635    set costt [expr cos($tt * $torad ) ]
636    return [expr ($X / $costt + $Y * $tantt) / 100.]
637}
638
639proc setlegend {box legend} {
640    global blt_version
641    if {$blt_version >= 2.3 && $blt_version < 8.0} {
642        if $legend {
643            $box legend config -hide no
644        } else {
645            $box legend config -hide yes
646        }
647    } else {
648        if $legend {
649            $box legend config -mapped yes
650        } else {
651            $box legend config -mapped no
652        }
653    }
654}
655
656trace variable newmenu(opt) w loadopt
657
658set graph(legend) 0
659set graph(equivwave) {}
660set graph(plotunits) tt
661if {$tcl_platform(platform) == "windows"} {
662    set graph(printout) 1
663} else {
664    set graph(printout) 0
665}
666set graph(outname) out.ps
667set graph(outcmd) lpr
668set datalist {}
669
670#----------------------------------------------------------------
671# where are we?
672set expgui(script) [info script]
673# translate links -- go six levels deep
674foreach i {1 2 3 4 5 6} {
675    if {[file type $expgui(script)] == "link"} {
676        set link [file readlink $expgui(script)]
677        if { [file  pathtype  $link] == "absolute" } {
678h           set expgui(script) $link
679        } {
680            set expgui(script) [file dirname $expgui(script)]/$link
681        }
682    } else {
683        break
684    }
685}
686# fixup relative paths
687if {[file pathtype $expgui(script)] == "relative"} {
688    set expgui(script) [file join [pwd] $expgui(script)]
689}
690set expgui(scriptdir) [file dirname $expgui(script) ]
691
692# fetch EXP file processing routines
693source [file join $expgui(scriptdir) readexp.tcl]
694
695# override options with locally defined values
696if [file exists [file join $expgui(scriptdir) localconfig]] {
697    source [file join $expgui(scriptdir) localconfig]
698}
699if [file exists [file join ~ .gsas_config]] {
700    source [file join ~ .gsas_config]
701}
702#----------------------------------------------------------------
703
704if {$expnam != ""} {
705    # OK now go get the profile info
706    getprofiles $expnam
707}
708
709#----------------------------------------------------------------
710foreach file [glob -nocomplain [file join $expgui(scriptdir) widplt_*]] {
711    source $file
712}
713
714# create the graph
715set box [graph .g]
716Blt_ZoomStack $box
717Blt_ActiveLegend $box
718Blt_ClosestPoint $box
719$box config -title {}
720$box yaxis config -title {FWHM}
721setlegend $box $graph(legend)
722#frame .a -bd 8 -relief groove
723frame .a -bd 2 -relief groove
724
725pack [menubutton .a.file -text File -underline 0 -menu .a.file.menu] -side left
726menu .a.file.menu
727pack [menubutton .a.plot -text "Plot Contents" -underline 0 -menu .a.plot.menu] -side left
728menu .a.plot.menu
729#.a.file.menu add cascade -label Tickmarks -menu .a.file.menu.tick
730if {$expnam != ""} {
731    .a.file.menu add command -label "Reload from EXP" \
732            -command "getprofiles $expnam; plotdata $box"
733}
734.a.file.menu add command -label "Add New Curve" -command newmenu
735.a.file.menu add command -label "Edit Curve" -command editmenu
736.a.file.menu add command -label "Make PostScript" -command makepostscriptout
737.a.file.menu add command -label Quit -command "destroy ."
738pack [menubutton .a.options -text Options -underline 0 -menu .a.options.menu] \
739        -side left   
740menu .a.options.menu
741.a.options.menu add radiobutton -label "2Theta" -value tt \
742        -variable graph(plotunits) \
743        -command "plotdata $box"
744.a.options.menu add command -label "Set Equiv. Wavelength" \
745        -command "seteqwave $box"
746.a.options.menu add radiobutton -label "d-space" -value d \
747        -variable graph(plotunits) \
748        -command "plotdata $box"
749.a.options.menu add radiobutton -label "Q" -value q \
750        -variable graph(plotunits) \
751        -command "plotdata $box"
752.a.options.menu add checkbutton -label "Include legend" \
753        -variable graph(legend) \
754        -command {setlegend $box $graph(legend)}
755.a.options.menu add command -label "Set PS output" \
756        -command setpostscriptout
757.a.options.menu add command -label "Save Options" -underline 1 \
758        -command "SaveOptions"
759
760pack [menubutton .a.help -text Help -underline 0 -menu .a.help.menu] -side right
761menu .a.help.menu -tearoff 0
762.a.help.menu add command -command aboutwidplot -label About
763
764foreach item $datalist {
765    .a.plot.menu add checkbutton -label $lblarr($item) \
766            -command "plotdata $box" -variable display($item)
767}
768
769pack .a -side top -fill both
770pack $box -fill both -expand yes
771set datanum 0
772donewait
Note: See TracBrowser for help on using the repository browser.