source: trunk/widplt @ 43

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

# on 1999/01/21 22:22:09, toby did:
now 1 arg (get gsasexe from location/.gsas_config)
use readexp.tcl
remove /tmp/ in makepostscriptout
move some global vars to array elements
use catch on compute loop for undefined widths
SaveOptions?
use localconfig & .gsas_config

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