source: trunk/widplt @ 86

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

# on 1999/04/08 20:44:22, toby did:
Add Id to header

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