source: trunk/widplt @ 756

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

# on 2003/11/21 00:46:52, toby did:
add export to grace & .csv options

  • Property rcs:author set to toby
  • Property rcs:date set to 2003/11/21 00:46:52
  • Property rcs:lines set to +152 -28
  • Property rcs:rev set to 1.16
  • Property rcs:state set to Exp
  • Property svn:keywords set to Author Date Revision Id
File size: 38.5 KB
Line 
1#!/bin/sh
2# the next line restarts this script using wish found in the path\
3exec wish "$0" "$@"
4# If this does not work, change the #!/usr/bin/wish line below
5# to reflect the actual wish location and delete all preceeding lines
6#
7# (delete here and above)
8#!/usr/bin/wish
9# $Id: widplt 756 2009-12-04 23:11:29Z toby $
10set Revision {$Revision: 756 $ $Date: 2009-12-04 23:11:29 +0000 (Fri, 04 Dec 2009) $}
11bind all <Control-KeyPress-c> {destroy .}
12set expnam [lindex $argv 0]
13if {$expnam != ""} {
14    if {[string toupper [file extension $expnam]] != ".EXP"} {
15        append expnam ".EXP"
16    }
17}
18set program [file tail $argv0]
19
20if [catch {package require BLT} errmsg] {
21    tk_dialog .err "BLT Error" "Error -- Unable to load the BLT package" \
22            error 0 Quit
23    destroy .
24}
25
26# handle Tcl/Tk v8+ where BLT is in a namespace
27#  use the command so that it is loaded
28catch {blt::graph}
29catch {
30    namespace import blt::graph
31    namespace import blt::vector
32}
33# old versions of blt don't report a version number
34if [catch {set blt_version}] {set blt_version 0}
35
36set expgui(debug) 0
37catch {if $env(DEBUG) {set expgui(debug) 1}}
38#set expgui(debug) 1
39
40proc waitmsg {message} {
41    set w .wait
42    # kill any window/frame with this name
43    catch {destroy $w}
44    pack [frame $w]
45    frame $w.bot -relief raised -bd 1
46    pack $w.bot -side bottom -fill both
47    frame $w.top -relief raised -bd 1
48    pack $w.top -side top -fill both -expand 1
49    label $w.msg -justify left -text $message -wrap 3i
50    catch {$w.msg configure -font \
51                -Adobe-Times-Medium-R-Normal--*-180-*-*-*-*-*-*
52    }
53    pack $w.msg -in $w.top -side right -expand 1 -fill both -padx 3m -pady 3m
54    label $w.bitmap -bitmap info
55    pack $w.bitmap -in $w.top -side left -padx 3m -pady 3m
56    update
57}
58
59proc donewaitmsg {} {
60    catch {destroy .wait}
61    update
62}
63
64if {$expnam != ""} {waitmsg "Loading $expnam, Please wait"}
65
66# get profile/absorption information out from an EXP file
67proc getprofiles {expnam} {
68    global WidSetList absSetList wave XY UVWP lblarr ttrange
69    global expmap
70
71    if {$expnam != ""} {
72        if {[expload $expnam] == -1} {
73            tk_dialog .err "EXP Error" "Warning -- Unable to read $expnam" \
74                error 0 OK
75            return
76        }
77        mapexp
78    } else {
79        set expmap(powderlist) {}
80    }
81    foreach hist $expmap(powderlist) {
82        # wavelength
83        set lambda1 [histinfo $hist lam1]
84        # data range
85        set drange [string trim [readexp "HST  $hist TRNGE"]]
86        global program
87        if {$program == "absplt"} {
88            global ABS
89            set ABS($hist) [list \
90                                [histinfo $hist abscor1] \
91                                [histinfo $hist abscor2] \
92                                [histinfo $hist abstype] \
93                                $drange \
94                                "Hist $hist" \
95                                $expmap(htype_$hist)]
96            lappend absSetList $hist
97        } else {
98            foreach phase $expmap(phaselist_$hist) {
99                set ptype [hapinfo $hist $phase proftype]
100                set pterms  [hapinfo $hist $phase profterms]
101                set key "H${hist}P${phase}"
102                # make sure the key is not present already
103                if {[lsearch $WidSetList $key] == -1} {
104                    lappend WidSetList $key
105                }
106                set lblarr($key) "Histogram $hist Phase $phase"
107                set wave($key) $lambda1
108                set ttrange($key) $drange
109                if {$ptype == 1} {
110                    set UVWP($key) [list [hapinfo $hist $phase pterm1] \
111                                        [hapinfo $hist $phase pterm2] \
112                                        [hapinfo $hist $phase pterm3] 0]
113                    set XY($key) {0 0}
114                } elseif {$ptype == 2} {
115                    set UVWP($key) [list [hapinfo $hist $phase pterm1] \
116                                        [hapinfo $hist $phase pterm2] \
117                                        [hapinfo $hist $phase pterm3] \
118                                        [hapinfo $hist $phase pterm9]]
119                    set XY($key) [list [hapinfo $hist $phase pterm4] \
120                                      [hapinfo $hist $phase pterm5]]
121                } elseif {$ptype == 3 || $ptype == 4} {
122                    set UVWP($key) [list [hapinfo $hist $phase pterm1] \
123                                        [hapinfo $hist $phase pterm2] \
124                                        [hapinfo $hist $phase pterm3] \
125                                        [hapinfo $hist $phase pterm4]]
126                    if {$ptype == 3} {
127                        set XY($key) [list [hapinfo $hist $phase pterm5] \
128                                          [hapinfo $hist $phase pterm6]]
129                    } else {
130                        set XY($key) [list [hapinfo $hist $phase pterm5] 0]
131                    }
132                }
133            }
134        }
135    }
136    MakeCascadeMenus
137}
138
139proc makepostscriptout {} {
140    global graph box
141    if !$graph(printout) {
142        set out [open "| $graph(outcmd) >& widplt.msg" w]
143        catch {
144            puts $out [$box postscript output -landscape 1 \
145                -decorations no -height 7.i -width 9.5i]
146            close $out
147        } msg
148        catch {
149            set out [open widplt.msg r]
150            if {$msg != ""} {append msg "\n"}
151            append msg [read $out]
152            close $out
153            file delete widplt.msg
154        }
155        if {$msg != ""} {
156            tk_dialog .msg "file created" \
157                    "Postscript file processed with command \
158                    $graph(outcmd). Result: $msg" "" 0 OK
159        } else {
160            tk_dialog .msg "file created" \
161                    "Postscript file processed with command \
162                    $graph(outcmd)" "" 0 OK
163        }
164    } else {
165        $box postscript output $graph(outname) -landscape 1 \
166                -decorations no -height 7.i -width 9.5i   
167        tk_dialog .msg "file created" \
168                "Postscript file $graph(outname) created" "" 0 OK
169    }
170}
171
172proc setprintopt {page} {
173    global graph
174    if $graph(printout) { 
175        $page.4.1 config -fg black
176        $page.4.2 config -fg black -state normal
177        $page.6.1 config -fg #888
178        $page.6.2 config -fg #888 -state disabled
179    } else {
180        $page.4.1 config -fg #888
181        $page.4.2 config -fg #888 -state disabled
182        $page.6.1 config -fg black
183        $page.6.2 config -fg black -state normal
184    }
185}
186
187proc seteqwave {top} {
188    global graph
189    set box .wave
190    catch {destroy $box}
191    toplevel $box
192    focus $box
193    grab $box
194    pack [frame $box.1] -side top
195    pack [label $box.1.a -text "Equivalent wavelength:"] -side top
196    pack [entry $box.1.b -textvariable graph(equivwave)] -side top
197    pack [frame $box.2] -side top
198    pack [button $box.2.c -text Clear -command "set graph(equivwave) {}; destroy $box"]
199    pack [button $box.2.u -text Use -command "destroy $box"]
200    tkwait window $box
201    plotdata $top
202}
203
204proc setpostscriptout {} {
205    global graph tcl_platform
206    set box .out
207    catch {destroy $box}
208    toplevel $box
209    focus $box
210    grab $box
211    pack [frame $box.4] -side top -anchor w -fill x
212    pack [checkbutton $box.4.a -text "Write PostScript files" \
213            -variable graph(printout) -offvalue 0 -onvalue 1 \
214            -command "setprintopt $box"] -side left -anchor w
215    pack [entry $box.4.2 -textvariable graph(outname)] -side right -anchor w
216    pack [label $box.4.1 -text "PostScript file name:"] -side right -anchor w
217    pack [frame $box.6] -side top -anchor w -fill x
218    pack [checkbutton $box.6.a -text "Print PostScript files" \
219            -variable graph(printout) -offvalue 1 -onvalue 0 \
220            -command "setprintopt $box" ] -side left -anchor w
221    pack [entry $box.6.2 -textvariable graph(outcmd)] -side right -anchor w
222    pack [label $box.6.1 -text "Command to print files:"] -side right -anchor w
223
224    pack [button $box.a -text "Close" -command "destroy $box"] -side top   
225    if {$tcl_platform(platform) == "windows"} {
226        set graph(printout) 1
227        $box.4.a config -state disabled
228        $box.6.a config -fg #888 -state disabled
229    }
230    setprintopt $box
231}
232
233proc aboutwidplot {} {
234    global Revision
235    tk_dialog .warn About "
236GSAS\n\
237A. C. Larson and\n R. B. Von Dreele,\n LANSCE, Los Alamos\n\n\
238WIDPLT/ABSPLT\nB. Toby, NIST\nNot subject to copyright\n\n\
239$Revision\n\
240" {} 0 OK
241}
242
243proc nextcolor {var} {
244    set num [uplevel "incr $var"]
245    return [lindex {red green blue cyan magenta yellow} [expr $num % 6]]
246}
247
248proc NewProfileValues {} {
249    global newmenu datanum
250    incr datanum
251    set base .edit
252    catch {destroy $base}
253    toplevel $base
254    focus $base
255    grab $base
256    wm title $base {Enter a new profile}
257    MakeEditProfileBox $base
258    grid [button $base.bttn1 -text Add \
259            -command "AddProfileValues; destroy $base"] -row 6 -column 6 
260    grid [button $base.bttn2 -text Quit \
261            -command "destroy $base"] -row 6 -column 7 
262    set newmenu(U) 0
263    set newmenu(V) 0
264    set newmenu(W) 0
265    set newmenu(P) 0
266    set newmenu(X) 0
267    set newmenu(Y) 0
268    set newmenu(min) 5
269    set newmenu(max) 100
270    set newmenu(label) "Curve #$datanum"
271    set newmenu(wave) 1.5418
272}
273
274proc AddProfileValues {} {
275    global newmenu datanum lblarr WidDisplay UVWP XY WidSetList ttrange wave
276    set key new$datanum
277    set UVWP($key) [list $newmenu(U) $newmenu(V) $newmenu(W) $newmenu(P)]
278    set XY($key) [list $newmenu(X) $newmenu(Y)]
279    set lblarr($key) $newmenu(label)
280    set ttrange($key) "$newmenu(min) $newmenu(max)"
281    set wave($key) $newmenu(wave)
282    lappend WidSetList $key
283    MakeCascadeMenus
284}
285
286proc editProfileValues {key} {
287    global newmenu WidSetList lblarr
288
289    set base .edit
290    catch {destroy $base}
291    toplevel $base
292    wm title $base {Edit a profile}
293    MakeEditProfileBox $base
294    grid [button $base.bttn1 -text Apply \
295            -command "SaveProfileEdits $key"] -row 6 -column 6 
296    grid [button $base.bttn2 -text Close \
297            -command "destroy $base"] -row 6 -column 7 
298
299    global UVWP XY ttrange wave lblarr
300    set newmenu(label) $lblarr($key)
301    set newmenu(U) [lindex $UVWP($key) 0]
302    set newmenu(V) [lindex $UVWP($key) 1]
303    set newmenu(W) [lindex $UVWP($key) 2]
304    set newmenu(P) [lindex $UVWP($key) 3]
305    set newmenu(X) [lindex $XY($key) 0]
306    set newmenu(Y) [lindex $XY($key) 1]
307    set newmenu(min) [lindex $ttrange($key) 0]
308    set newmenu(max) [lindex $ttrange($key) 1]
309    set newmenu(wave) $wave($key)
310}
311
312proc SaveProfileEdits {key} {
313    global newmenu datanum lblarr WidDisplay UVWP XY WidSetList ttrange wave box
314    set UVWP($key) [list $newmenu(U) $newmenu(V) $newmenu(W) $newmenu(P)]
315    set XY($key) [list $newmenu(X) $newmenu(Y)]
316    set ttrange($key) [list $newmenu(min) $newmenu(max)]
317    set wave($key) $newmenu(wave)
318    set lblarr($key) $newmenu(label)
319    MakeCascadeMenus
320    plotdata $box 
321}
322
323proc MakeEditProfileBox {base} {
324    grid [label $base.lb7 -text Gaussian] -row 2 -column 1  -columnspan 4
325    grid [label $base.lb8 -text Lorentz] -row 2 -column 6  -columnspan 2
326    grid [label $base.lb1 -text U] -row 3 -column 1
327    grid [label $base.lb2 -text V] -row 3 -column 2 
328    grid [label $base.lb3 -text W] -row 3 -column 3 
329    grid [label $base.lb4 -text P] -row 3 -column 4 
330    grid [label $base.lb5 -text X] -row 3 -column 6 
331    grid [label $base.lb6 -text Y] -row 3 -column 7
332    grid [entry $base.ent1 -textvariable newmenu(U) -width 12] \
333            -row 4 -column 1
334    grid [entry $base.ent2 -textvariable newmenu(V) -width 12] \
335            -row 4 -column 2 
336    grid [entry $base.ent3 -textvariable newmenu(W) -width 12] \
337            -row 4 -column 3 
338    grid [entry $base.ent4 -textvariable newmenu(P) -width 12] \
339            -row 4 -column 4 
340    grid [entry $base.ent5 -textvariable newmenu(X) -width 12] \
341            -row 4 -column 6 
342    grid [entry $base.ent6 -textvariable newmenu(Y) -width 12] \
343            -row 4 -column 7
344
345    grid [label $base.lb9 -text label] -row 5 -column 1  -sticky e
346    grid [entry $base.ent7 -textvariable newmenu(label)]\
347            -row 5 -column 2  -columnspan 3 -sticky ew
348
349    grid [label $base.lb13 -text Wavelength] -row 5 -column 5 -columnspan 2
350    grid [entry $base.ent11 -textvariable newmenu(wave) -width 8] \
351            -row 5 -column 7
352
353    grid [label $base.lb11 -text {2Theta Min}] -row 6 -column 1 
354    grid [entry $base.ent9 -textvariable newmenu(min) -width 9] \
355            -row 6 -column 2
356    grid [label $base.lb12 -text {2Theta Max}] -row 6 -column 3
357    grid [entry $base.ent10 -textvariable newmenu(max) -width 9] \
358            -row 6 -column 4
359    grid rowconfigure $base 5 -weight 0 -pad 40
360    grid columnconfigure $base 5 -weight 0 -minsize 25
361}
362
363proc editAbsValues {key} {
364    global newmenu absSetList lblarr
365
366    set base .edit
367    catch {destroy $base}
368    toplevel $base
369    wm title $base {Edit Absorption Values}
370    MakeEditAbsBox $base
371    grid [button $base.bttn1 -text Apply \
372            -command "SaveAbsorptionEdits $key"] -row 8 -column 6 
373    grid [button $base.bttn2 -text Close \
374            -command "destroy $base"] -row 8 -column 7 
375
376    global ABS
377    foreach v {1 2 opt range label htype} val $ABS($key) {
378        set newmenu($v) $val
379    }
380    foreach {newmenu(min) newmenu(max)} $newmenu(range) {}
381    if {[string range $newmenu(htype) 2 2] == "T"} {
382        set newmenu(units) "TOF (ms):"
383    } elseif {[string range $newmenu(htype) 2 2] == "C"} {
384        set newmenu(units) "2-Theta (deg):"
385    } elseif {[string range $newmenu(htype) 2 2] == "E"} {
386        set newmenu(units) "Energy (KeV):"
387    }
388}
389
390proc SaveAbsorptionEdits {key} {
391    global ABS newmenu box
392    set ABS($key) [list \
393            $newmenu(1) $newmenu(2) $newmenu(opt) \
394            [list $newmenu(min) $newmenu(max)] \
395            $newmenu(label) \
396            [lindex $ABS($key) 5]]
397    plotdata $box 
398}
399
400proc MakeEditAbsBox {base} {
401    grid [label $base.lb1 -text "Absorption Coefficients"] \
402            -row 2 -column 1  -columnspan 2
403    grid [label $base.lb1a -text "1"] -row 3 -column 1
404    grid [label $base.lb2a -text "2"] -row 3 -column 2
405    grid [label $base.lb3 -text Absorption\nFunction] \
406            -row 2 -column 6 -rowspan 2 -columnspan 2
407    grid [entry $base.ent1 -textvariable newmenu(1) -width 12] \
408            -row 4 -column 1
409    grid [entry $base.ent2 -textvariable newmenu(2) -width 12] \
410            -row 4 -column 2 
411    eval tk_optionMenu $base.m1 newmenu(opt) 0 1 2 3 4
412    grid $base.m1 -row 4 -column 6 -columnspan 2
413
414    grid [label $base.lb8 -textvariable newmenu(opttxt) \
415          -wrap 180 -justify left] -row 5 -column 1  -sticky e -columnspan 7
416    grid [label $base.lb9 -text label] -row 7 -column 1  -sticky e
417    grid [entry $base.ent7 -textvariable newmenu(label)]\
418            -row 7 -column 2  -columnspan 3 -sticky ew
419
420    grid [frame $base.f] -row 8 -column 1 -columnspan 4
421    grid [label $base.f.1 -textvariable newmenu(units)] -row 0 -column 1 
422    grid [label $base.f.2 -text {Min}] -row 0 -column 2
423    grid [entry $base.f.3 -textvariable newmenu(min) -width 9] \
424            -row 0 -column 3
425    grid [label $base.f.4 -text {Max}] -row 0 -column 4
426    grid [entry $base.f.5 -textvariable newmenu(max) -width 9] \
427            -row 0 -column 5
428    grid rowconfigure $base 6 -min 15
429}
430
431proc plotdata {top} {
432    global program graph
433    global UVWP XY wave lblarr WidSetList WidDisplay ttrange
434    global ABS absSetList AbsDisplay
435    if {$graph(plotunits) == "d"} {
436        $top xaxis configure -title "d (A)"
437    } elseif {$graph(plotunits) == "q"} {
438        $top xaxis configure -title "Q (A-1)"
439    } elseif {$graph(equivwave) == ""} {
440        $top xaxis configure -title "2Theta"
441    } else {
442        $top xaxis configure -title "2Theta @ $graph(equivwave)"
443    }
444    if {$program == "absplt"} {
445        $top yaxis config -title {Abs. Corr.} 
446    } else {
447        $top yaxis config -title {FWHM} 
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    if {$program == "absplt"} {
455        foreach item $absSetList {
456            if {$AbsDisplay($item)} {
457                set ttlist {}
458                set abscor1 [lindex $ABS($item) 0]
459                set abscor2 [lindex $ABS($item) 1]
460                set abstype [lindex $ABS($item) 2]
461                set abslbl [lindex $ABS($item) 4]
462                set htype [lindex $ABS($item) 5]
463                set ttmin [lindex [lindex $ABS($item) 3] 0]
464                set ttmax [lindex [lindex $ABS($item) 3] 1]
465                set ttstep [expr {($ttmax - $ttmin)/50.}]
466                if {$graph(equivwave) == ""} {
467                    if {[string range $htype 2 2] == "T"} {
468                        $top xaxis configure -title "TOF (ms)"
469                    } elseif {[string range $htype 2 2] == "E"} {
470                        $top xaxis configure -title "Energy (KeV)"
471                    }
472                }
473                for     {set tt $ttmin} \
474                        {$tt <= $ttmax} \
475                        {set tt [expr {$tt + $ttstep}]} {
476                    catch {
477                        lappend abslist [AbsorbCalc \
478                                $item $tt $abscor1 $abscor2 $abstype]
479                        lappend ttlist $tt
480                    }
481                }
482                if {[llength $ttlist] == 0} continue
483                if {$graph(plotunits) == "d"} {
484                    set ttlist [tod $ttlist $item]
485                } elseif {$graph(plotunits) == "q"} {
486                    set ttlist [toQ $ttlist $item]
487                }
488                catch {
489                    $top element create $item
490                }
491                $top element config $item -label $abslbl \
492                        -xdata $ttlist -ydata $abslist -linewidth 3 \
493                        -color [nextcolor num]
494            }
495        }
496    } else {
497        foreach item $WidSetList {
498            if {$WidDisplay($item)} {
499                if {[expr [lindex $XY($item) 0] + [lindex $XY($item) 1]] != 0} {
500                    set lflag 1
501                } else {
502                    set lflag 0
503                }
504                set ttlist {}
505                set fwhmlist {}
506                set lfwhmlist {}
507                set tfwhmlist {}
508                # loop over two-theta
509                for     {set tt [lindex $ttrange($item) 0]} \
510                        {$tt <= [lindex $ttrange($item) 1]} \
511                        {set tt [expr $tt + 4]} {
512                    set lfwhm 0
513                    catch {
514                        if {$graph(plotunits) == "d"} {
515                            lappend ttlist [tt2d $wave($item) $tt ]
516                            set gfwhm [deltad $wave($item) $tt \
517                                    [eval FWHM $tt $UVWP($item)]]
518                            lappend fwhmlist $gfwhm
519                            if $lflag {
520                                set lfwhm [deltad $wave($item) $tt \
521                                        [eval LFWHM $tt $XY($item)]]
522                                lappend lfwhmlist $lfwhm
523                            }
524                        } elseif {$graph(plotunits) == "q"} {
525                            lappend ttlist [tt2Q $wave($item) $tt ]
526                            set gfwhm [deltaQ $wave($item) $tt \
527                                    [eval FWHM $tt $UVWP($item)]]
528                            lappend fwhmlist $gfwhm
529                            if $lflag {
530                                set lfwhm [deltaQ $wave($item) $tt \
531                                        [eval LFWHM $tt $XY($item)]]
532                                lappend lfwhmlist $lfwhm
533                            }
534                        } elseif {$graph(equivwave) == ""} {
535                            lappend ttlist $tt
536                            set gfwhm [eval FWHM $tt $UVWP($item)]
537                            lappend fwhmlist $gfwhm
538                            if $lflag {
539                                set lfwhm [eval LFWHM $tt $XY($item)]
540                                lappend lfwhmlist $lfwhm
541                            }
542                        } else {
543                            set tteq [ttequiv $wave($item) $tt $graph(equivwave)]
544                            if {$tteq != ""} {
545                                lappend ttlist $tteq
546                                set gfwhm [delta2teq $wave($item) $tt \
547                                        [eval FWHM $tt $UVWP($item)] $graph(equivwave)]
548                                lappend fwhmlist $gfwhm
549                                if $lflag {
550                                    set lfwhm [delta2teq $wave($item) $tt \
551                                            [eval LFWHM $tt $XY($item)] $graph(equivwave)]
552                                    lappend lfwhmlist $lfwhm
553                                }
554                            }
555                        }
556                        # assume FWHM add as square roots
557                        lappend tfwhmlist \
558                                [expr sqrt($gfwhm*$gfwhm + $lfwhm*$lfwhm)]
559                    }
560                }
561                if $lflag {
562                    catch {
563                        $top element create ${item}G -label "$lblarr($item) G" 
564                    }
565                    $top element config ${item}G \
566                            -xdata $ttlist -ydata $fwhmlist -linewidth 3 \
567                            -color [nextcolor num]
568                    catch {
569                        $top element create ${item}L -label "$lblarr($item) L"
570                    }
571                    $top element config ${item}L \
572                            -xdata $ttlist -ydata $lfwhmlist -linewidth 3 \
573                            -color [nextcolor num]
574                }
575                catch {
576                    $top element create $item -label $lblarr($item) 
577                }
578                $top element config $item \
579                        -xdata $ttlist -ydata $tfwhmlist -linewidth 3 \
580                        -color [nextcolor num]
581            }
582        }
583    }
584}
585proc AbsorbCalc {hst ttof abscor1 abscor2 mode} {
586    global expmap
587    set htype $expmap(htype_$hst)
588    set pi [expr {2.*acos(0.)}]
589    # determine sin(theta) & lambda
590    if {[string range $htype 2 2] == "T"} {
591        set sth [expr {sin($pi * abs([histinfo $hst tofangle])/360.)}]
592        set lamb [expr {2 * [toftod $ttof $hst] * $sth}]
593    } elseif {[string range $htype 2 2] == "C"} {
594        set lamb [histinfo $hst lam1]
595        set sth [expr {sin($pi * ($ttof - [histinfo $hst zero]/100.)/360.)}]
596    } elseif {[string range $htype 2 2] == "E"} {
597        set lamb [expr { 12.398 / $ttof}]
598        set sth [expr {sin($pi * [histinfo $hst lam1] / 360.)}]
599    }
600    set sth2 [expr $sth*$sth]
601    set cth2 [expr {1 - $sth2}]
602    set cth  [expr {sqrt($cth2)}]
603
604    if {$mode == 0} { 
605        set murl [expr {$abscor1 * $lamb}]; # Lobanov & Alte da Veiga
606        if {$murl <= 3} {
607            set TERM0 [expr { 16.0/(3*$pi) }]
608            set TERM1 [expr { (25.99978-0.01911*pow($sth2,0.25)) * \
609                    exp(-0.024551*$sth2) + 0.109561*sqrt($sth2)-26.04556 }]
610            set TERM2 [expr {-0.02489 - 0.39499*$sth2 + \
611                    1.219077*pow($sth2,1.5) - 1.31268*pow($sth2,2) + \
612                    0.871081*pow($sth2,2.5) - 0.2327*pow($sth2,3) }]
613            set TERM3 [expr { 0.003045+0.018167*$sth2 - 0.03305*pow($sth2,2) }]
614            set TRANS [expr { -$TERM0*$murl - $TERM1*pow($murl,2) - \
615                    $TERM2*pow($murl,3) - $TERM3*pow($murl,4) }]
616            if {$TRANS <= -20.0} {
617                set TRANS 2.06E-9
618            } elseif {$TRANS >= 20.0} {
619                set TRANS 4.85E8
620            } else {
621                set TRANS [expr {exp($TRANS)}]
622            }
623        } else {
624            set TERM1 [expr { 1.433902 + 11.07504*$sth2 - \
625                    8.77629*pow($sth2,2) + 10.02088*pow($sth2,3) - \
626                    3.36778*pow($sth2,4) }]
627            set TERM2 [expr { (0.013869 - 0.01249*$sth2) * \
628                    exp(3.27094*$sth2) + \
629                    (0.337894 + 13.77317*$sth2) / \
630                    pow((1.0+11.53544*$sth2),1.555039) }]
631            set TERM3 [expr { 1.933433 / pow((1.0+23.12967*$sth2),1.686715) - \
632                    0.13576*sqrt($sth2) + 1.163198}]
633            set TERM4 [expr { 0.044365 - 0.4259 / \
634                    pow((1.0+0.41051*$sth2),148.4202) }]
635            set TRANS [expr { ($TERM1-$TERM4) / \
636                    pow((1.0+$TERM2*($murl-3.0)),$TERM3) + $TERM4 }]
637            set TRANS [expr { $TRANS/100.0}]
638        }
639    } elseif {$mode == 1} { 
640        #!Simple linear absorption
641        set TRANS [expr { -$abscor1*$lamb }]
642        set TRANS [expr { exp($TRANS) }]
643    } elseif {$mode == 2} { 
644        #!Pitschke, Hermann & Muttern - surface roughness
645        set TERM1 [expr { 1.0/$sth-$abscor2/$sth2 }]
646        set TERM2 [expr { 1.0-$abscor1*(1.0+$abscor2) }]
647        set TRANS [expr { (1.0-$abscor1*$TERM1)/$TERM2 }]
648    } elseif {$mode == 3} { 
649        #!Suortti - surface roughness
650        set TERM1 [expr { exp(-$abscor2/$sth) }]
651        set TERM2 [expr { $abscor1 + (1.0-$abscor1) * exp(-$abscor2) }]
652        set TRANS [expr { ($abscor1 +(1.0-$abscor1) * $TERM1)/$TERM2 }]
653    } elseif {$mode == 4} { 
654        #!Plate transmission absorption
655        if {abs($abscor2) < 1} {
656            #!Use symmetric fxn. if phi 1 deg or less
657            set TRANS [expr { -$abscor1*$lamb/$cth }]
658            set TRANS [expr { exp($TRANS) }]
659        } else {
660            #!Bigger tilts
661            set SPH [expr { sin($pi/180. * $abscor2) }]
662            set CPH [expr { cos($pi/180. * $abscor2) }]
663            set CTPP [expr { $CPH*$cth - $SPH*$sth }]
664            set CTMP [expr { $CPH*$cth + $SPH*$sth }]
665            set T [expr { -$abscor1*$lamb }]
666            set T1 [expr { $T / $CTPP }]
667            set TRANS1 [expr { exp($T1) }]
668            set T2 [expr { $T/$CTMP }]
669            set TRANS2 [expr { exp($T2) }]
670            set TB [expr { $T * (1.0 - $CTMP / $CTPP) }]
671            set TRANS [expr { ($TRANS1 - $TRANS2) / $TB }]
672        }
673    }
674    return $TRANS
675}
676
677# save some of the global options in ~/.gsas_config
678proc SaveOptions {} {
679    global graph  tcl_platform
680    if {$tcl_platform(platform) == "windows"} {
681        set fp [open c:/gsas.config a]
682    } else {
683        set fp [open [file join ~ .gsas_config] a]
684    }
685    puts $fp "# WIDPLT saved options from [clock format [clock ticks]]"
686    puts $fp "set graph(legend) [list $graph(legend)]"
687    puts $fp "set graph(printout) [list $graph(printout)]"
688    puts $fp "set graph(outname) [list $graph(outname)]"
689    puts $fp "set graph(outcmd) [list $graph(outcmd)]"
690    puts $fp "set graph(plotunits) [list $graph(plotunits)]"
691    puts $fp "set graph(equivwave) [list $graph(equivwave)]"
692    close $fp
693}
694
695proc MakeCascadeMenus {} {
696    global WidSetList lblarr box absSetList ABS
697    .a.plot.menu delete 0 end
698    .a.file.menu.edit delete 0 end
699    global program
700    if {$program != "absplt"} {
701        foreach item $WidSetList {
702            .a.plot.menu add checkbutton -label $lblarr($item) \
703                    -command "plotdata $box" -variable WidDisplay($item)
704            .a.file.menu.edit add command -label $lblarr($item) \
705                    -command "editProfileValues $item"
706        }
707    } else {
708        foreach item $absSetList {
709            .a.plot.menu add checkbutton -label [lindex $ABS($item) 4] \
710                    -command "plotdata $box" -variable AbsDisplay($item)
711            .a.file.menu.edit add command -label [lindex $ABS($item) 4] \
712                    -command "editAbsValues $item"
713        }
714    }
715}
716#-------------------------------------------------------------------------
717# converts 2theta(deg) to Q (A-1)
718proc tt2Q {lambda twotheta} {
719    set pi 3.14159
720    set torad [expr $pi / 360.]
721    return [expr 4 * $pi / ($lambda) * sin (($twotheta) * $torad)]
722}
723
724# converts Q (A-1) to 2theta(deg)
725proc Q2tt {lambda Q} {
726    set pi 3.14159
727    set todeg [expr 360. / $pi]
728    set asinarg [expr ($lambda) * $Q * 0.25 / $pi]
729    if {$asinarg <= 1} {
730        return [expr $todeg * asin ($asinarg)]
731    }
732    return {}
733}
734
735# converts a FWHM in 2theta(deg) to a FWHM in Q (A-1)
736proc deltaQ {lambda twotheta FWHM} {
737    return [expr [tt2Q $lambda $twotheta+($FWHM/2.)] - \
738                 [tt2Q $lambda $twotheta-($FWHM/2.)] ]
739}
740
741# converts 2theta(deg) to d (A)
742proc tt2d {lambda twotheta} {
743    set pi 3.14159
744    set torad [expr $pi / 360.]
745    return [expr 0.5 * ($lambda) / sin (($twotheta) * $torad)]
746}
747
748# converts d (A) to 2theta(deg)
749proc d2tt {lambda d} {
750    set pi 3.14159
751    set todeg [expr 360. / $pi]
752    set asinarg [expr ($lambda) * 0.5 / $d]
753    if {$asinarg <= 1} {
754        return [expr $todeg * asin ($asinarg)]
755    }
756    return {}
757}
758
759# converts a FWHM in 2theta(deg) to a FWHM in Q (A-1)
760proc deltad {lambda twotheta FWHM} {
761    return [expr [tt2d $lambda $twotheta-($FWHM/2.)] - \
762                 [tt2d $lambda $twotheta+($FWHM/2.)] ]
763}
764
765# computes an equivalent 2theta at a different wavelength
766proc ttequiv {lambda twotheta lambda_eq} {
767    return [Q2tt $lambda_eq [tt2Q $lambda $twotheta]]
768}
769
770# converts a FWHM in 2theta(deg) to a FWHM at in 2theta
771# at a different wavelength
772proc delta2teq {lambda twotheta FWHM lambda_eq} {
773    return [expr [Q2tt $lambda_eq [tt2Q $lambda $twotheta+($FWHM/2.)]] - \
774                 [Q2tt $lambda_eq [tt2Q $lambda $twotheta-($FWHM/2.)]] ]
775}
776
777# convert x values to d-space
778proc tod {xlist hst} {
779    global expmap
780    if {[string range $expmap(htype_$hst) 2 2] == "T"} {
781        return [toftod $xlist $hst]
782    } elseif {[string range $expmap(htype_$hst) 2 2] == "C"} {
783        return [tttod $xlist $hst]
784    } elseif {[string range $expmap(htype_$hst) 2 2] == "E"} {
785        return [engtod $xlist $hst]
786    } else {
787        return {}
788    }
789}
790
791# convert tof to d-space
792proc toftod {toflist hst} {
793    set difc [expr {[histinfo $hst difc]/1000.}]
794    set difc2 [expr {$difc*$difc}]
795    set difa [expr {[histinfo $hst difa]/1000.}]
796    set zero [expr {[histinfo $hst zero]/1000.}]
797    set ans {}
798    foreach tof $toflist {
799        if {$tof == 0.} {
800            lappend ans 0.
801        } elseif {$tof == 1000.} {
802            lappend ans 1000.
803        } else {
804            set td [expr {$tof-$zero}]
805            lappend ans [expr {$td*($difc2+$difa*$td)/ \
806                    ($difc2*$difc+2.0*$difa*$td)}]
807        }
808    }
809    return $ans
810}
811
812# convert two-theta to d-space
813proc tttod {twotheta hst} {
814    set lamo2 [expr {0.5 * [histinfo $hst lam1]}]
815    set zero [expr [histinfo $hst zero]/100.]
816    set ans {}
817    set cnv [expr {acos(0.)/180.}]
818    foreach tt $twotheta {
819        if {$tt == 0.} {
820            lappend ans 99999.
821        } elseif {$tt == 1000.} {
822            lappend ans 0.
823        } else {
824            lappend ans [expr {$lamo2 / sin($cnv*($tt-$zero))}]
825        }
826    }
827    return $ans
828}
829
830# convert energy (edx-ray) to d-space
831# (note that this ignores the zero correction)
832proc engtod {eng hst} {
833    set lam [histinfo $hst lam1]
834    set zero [histinfo $hst zero]
835    set ans {}
836    set v [expr {12.398/(2.0*[sind[expr ($lam/2.0)]])}]
837    foreach e $eng {
838        if {$e == 0.} {
839            lappend ans 1000.
840        } elseif {$e == 1000.} {
841            lappend ans 0.
842        } else {
843            lappend ans [expr {$v/$e}]
844        }
845    }
846    return $ans
847}
848
849# convert x values to Q
850proc toQ {xlist hst} {
851    global expmap
852    if {[string range $expmap(htype_$hst) 2 2] == "T"} {
853        return [toftoQ $xlist $hst]
854    } elseif {[string range $expmap(htype_$hst) 2 2] == "C"} {
855        return [tttoQ $xlist $hst]
856    } elseif {[string range $expmap(htype_$hst) 2 2] == "E"} {
857        return [engtoQ $xlist $hst]
858    } else {
859        return {}
860    }
861}
862# convert tof to Q
863proc toftoQ {toflist hst} {
864    set difc [expr {[histinfo $hst difc]/1000.}]
865    set difc2 [expr {$difc*$difc}]
866    set difa [expr {[histinfo $hst difa]/1000.}]
867    set zero [expr {[histinfo $hst zero]/1000.}]
868    set 2pi [expr {4.*acos(0.)}]
869    set ans {}
870    foreach tof $toflist {
871        if {$tof == 0.} {
872            lappend ans 99999.
873        } elseif {$tof == 1000.} {
874            lappend ans 0.
875        } else {
876            set td [expr {$tof-$zero}]
877            lappend ans [expr {$2pi * \
878                    ($difc2*$difc+2.0*$difa*$td)/($td*($difc2+$difa*$td))}]
879        }
880    }
881    return $ans
882}
883
884# convert two-theta to Q
885proc tttoQ {twotheta hst} {
886    set lamo2 [expr {0.5 * [histinfo $hst lam1]}]
887    set zero [expr [histinfo $hst zero]/100.]
888    set ans {}
889    set cnv [expr {acos(0.)/180.}]
890    set 2pi [expr {4.*acos(0.)}]
891    foreach tt $twotheta {
892        if {$tt == 0.} {
893            lappend ans 0.
894        } elseif {$tt == 1000.} {
895            lappend ans 1000.
896        } else {
897            lappend ans [expr {$2pi * sin($cnv*($tt-$zero)) / $lamo2}]
898        }
899    }
900    return $ans
901}
902# convert energy (edx-ray) to Q
903# (note that this ignores the zero correction)
904proc engtoQ {eng hst} {
905    set lam [histinfo $hst lam1]
906    set zero [histinfo $hst zero]
907    set ans {}
908    set v [expr {12.398/(2.0*[sind[expr ($lam/2.0)]])}]
909    set 2pi [expr {4.*acos(0.)}]
910    foreach e $eng {
911        if {$e == 0.} {
912            lappend ans 0.
913        } elseif {$e == 1000.} {
914            lappend ans 1000.
915        } else {
916            lappend ans [expr {$2pi * $e / $v}]
917        }
918    }
919    return $ans
920}
921proc sind {angle} {
922    return [expr {sin($angle*acos(0.)/90.)}]
923}
924
925proc FWHM {tt U V W P} {
926    set pi 3.14159
927    set torad [expr $pi / 360.]
928    # tan theta
929    set tantt [expr tan($tt * $torad ) ]
930    set costt [expr cos($tt * $torad ) ]
931    return [expr sqrt \
932            (8.* log(2) * ($U * $tantt * $tantt + $V * $tantt + $W \
933            + $P / ($costt * $costt))) / 100.]
934}
935proc LFWHM {tt X Y} {
936    set pi 3.14159
937    set torad [expr $pi / 360.]
938    # tan theta
939    set tantt [expr tan($tt * $torad ) ]
940    set costt [expr cos($tt * $torad ) ]
941    return [expr ($X / $costt + $Y * $tantt) / 100.]
942}
943
944proc setlegend {box legend} {
945    global blt_version
946    if {$blt_version >= 2.3 && $blt_version < 8.0} {
947        if $legend {
948            $box legend config -hide no
949        } else {
950            $box legend config -hide yes
951        }
952    } else {
953        if $legend {
954            $box legend config -mapped yes
955        } else {
956            $box legend config -mapped no
957        }
958    }
959}
960
961#-------------------------------------------------------------------------
962# export current plot to Grace
963#-------------------------------------------------------------------------
964if {$tcl_platform(platform) == "unix"} {
965    set graph(GraceFile) /tmp/grace_out.agr
966} else {
967    set graph(GraceFile) C:/graceout.agr
968}
969proc exportgrace {} {
970    global graph box
971    global tcl_platform graph
972    catch {toplevel .export}
973    raise .export
974    eval destroy [grid slaves .export]
975    set col 5
976    grid [label .export.1a -text Title:] -column 1 -row 1
977    set graph(title) [$box cget -title]
978    grid [entry .export.1b -width 60 -textvariable graph(title)] \
979            -column 2 -row 1 -columnspan 4
980    grid [label .export.2a -text Subtitle:] -column 1 -row 2
981    grid [entry .export.2b -width 60 -textvariable graph(subtitle)] \
982            -column 2 -row 2 -columnspan 4
983    grid [label .export.3a -text "File name:"] -column 1 -row 3
984    grid [entry .export.3b -width 60 -textvariable graph(GraceFile)] \
985            -column 2 -row 3 -columnspan 4
986    grid [button .export.help -text Help -bg yellow \
987            -command "MakeWWWHelp liveplot.html grace"] \
988            -column [incr col -1] -row 4
989    grid [button .export.c -text "Close" \
990            -command "set graph(export) 0; destroy .export"] \
991            -column [incr col -1] -row 4
992    if {$tcl_platform(platform) == "unix" && [auto_execok xmgrace] != ""} {
993        grid [button .export.d -text "Export & \nstart grace" \
994            -command "set graph(export) 1; destroy .export"] \
995                -column [incr col -1] -row 4
996    }
997    grid [button .export.e -text "Export" \
998            -command "set graph(export) 2; destroy .export"] \
999            -column [incr col -1] -row 4
1000    tkwait window .export
1001    if {$graph(export) == 0} return
1002    if {[catch {
1003        set fp [open $graph(GraceFile) w]
1004        puts $fp [output_grace $box $graph(title) $graph(subtitle)]
1005        close $fp
1006    } errmsg]} {
1007        MyMessageBox -parent . -title "Export Error" \
1008                -message "An error occured during the export: $errmsg" \
1009                -icon error -type Ignore -default ignore
1010        return
1011    }
1012
1013    if {$graph(export) == 1} {
1014        set err [catch {exec xmgrace $graph(GraceFile) &} errmsg]
1015        if $err {
1016        MyMessageBox -parent . -title "Grace Error" \
1017                -message "An error occured launching grace (xmgrace): $errmsg" \
1018                -icon error -type Ignore -default ignore
1019        }
1020    } else {
1021        MyMessageBox -parent . -title "OK" \
1022                -message "File $graph(GraceFile) created" \
1023                -type OK -default ok
1024    }
1025}
1026#-------------------------------------------------------------------------
1027# export current plot as .csv file
1028#-------------------------------------------------------------------------
1029proc makecsvfile {} {
1030    global graph box expnam program
1031    global tcl_platform graph
1032    set typelist {
1033        {{Comma separated} {.csv}        }
1034        {{Text File}       {.txt}        }
1035    }
1036    set file [tk_getSaveFile -filetypes $typelist \
1037            -initialfile ${expnam}_$program.csv]
1038    if {$file == ""} return
1039    set varlist {}
1040    set line {}
1041    foreach element_name [$box element names] {
1042        lappend varlist ${element_name}_x
1043        set ${element_name}_x [$box element cget $element_name -xdata]
1044        lappend varlist ${element_name}_y
1045        set ${element_name}_y [$box element cget $element_name -ydata]
1046        append line [$box element cget $element_name -label] "-X, "
1047        append line [$box element cget $element_name -label] "-Y, "
1048    }
1049    set fp [open $file w]
1050    # get x and y axis limits
1051    foreach v {x y} {
1052        foreach "${v}min ${v}max" [$box ${v}axis limits] {}
1053        puts $fp "\"$v axis range [set ${v}min] to [set ${v}max]\""
1054        puts $fp "\"$v axis label [$box ${v}axis cget -title]\""
1055    }
1056    puts $fp $line
1057    set i 0
1058    set done 1
1059    while {$done} {
1060        set line {}
1061        set done 0
1062        foreach var $varlist {
1063            set val [lindex [set $var] $i]
1064            if {$val != ""} {set done 1}
1065            append line "$val, "
1066        }
1067        if {$done} {puts $fp $line}
1068        incr i
1069    }
1070    close $fp
1071}
1072
1073
1074set graph(legend) 0
1075set graph(equivwave) {}
1076set graph(plotunits) tt
1077if {$tcl_platform(platform) == "windows"} {
1078    set graph(printout) 1
1079} else {
1080    set graph(printout) 0
1081}
1082set graph(outname) out.ps
1083set graph(outcmd) lpr
1084set WidSetList {}
1085set absSetList {}
1086
1087#----------------------------------------------------------------
1088# where are we?
1089set expgui(script) [info script]
1090# translate links -- go six levels deep
1091foreach i {1 2 3 4 5 6} {
1092    if {[file type $expgui(script)] == "link"} {
1093        set link [file readlink $expgui(script)]
1094        if { [file  pathtype  $link] == "absolute" } {
1095h           set expgui(script) $link
1096        } {
1097            set expgui(script) [file dirname $expgui(script)]/$link
1098        }
1099    } else {
1100        break
1101    }
1102}
1103# fixup relative paths
1104if {[file pathtype $expgui(script)] == "relative"} {
1105    set expgui(script) [file join [pwd] $expgui(script)]
1106}
1107set expgui(scriptdir) [file dirname $expgui(script) ]
1108set expgui(docdir) [file join $expgui(scriptdir) doc]
1109# location for web pages, if not found locally
1110set expgui(website) www.ncnr.nist.gov/xtal/software/expgui
1111
1112# fetch EXP file processing routines
1113source [file join $expgui(scriptdir) readexp.tcl]
1114source [file join $expgui(scriptdir) gsascmds.tcl]
1115
1116# override options with locally defined values
1117set filelist [file join $expgui(scriptdir) localconfig]
1118if {$tcl_platform(platform) == "windows"} {
1119    lappend filelist "c:/gsas.config"
1120} else {
1121    lappend filelist [file join ~ .gsas_config]
1122}
1123if {[catch {
1124    foreach file $filelist {
1125        if [file exists $file] {source $file}
1126    }
1127} errmsg]} {
1128    set msg "Error reading file $file (aka [file nativename $file]): $errmsg"
1129    MyMessageBox -parent . -title "Customize warning" \
1130        -message $msg -icon warning -type Ignore -default ignore \
1131        -helplink "expguierr.html Customizewarning"
1132}
1133#----------------------------------------------------------------
1134
1135set datalist {}
1136foreach file [glob -nocomplain [file join $expgui(scriptdir) widplt_*]] {
1137    source $file
1138}
1139set WidSetList $datalist
1140
1141# create the graph
1142if [catch {
1143    set box [graph .g]
1144} errmsg] {
1145    tk_dialog .err "BLT Error" \
1146"BLT Setup Error: could not create a graph (msg: $errmsg). \
1147There is a problem with the setup of BLT on your system.
1148See the expgui.html file for more info." \
1149            error 0 "Quit"
1150exit
1151}
1152if [catch {
1153    Blt_ZoomStack $box
1154    Blt_ActiveLegend $box
1155    Blt_ClosestPoint $box
1156} errmsg] {
1157    tk_dialog .err "BLT Error" \
1158"BLT Setup Error: could not access a Blt_ routine (msg: $errmsg). \
1159The pkgIndex.tcl is probably not loading bltGraph.tcl.
1160See the expgui.html file for more info." \
1161            error 0 "Limp ahead"
1162}
1163$box config -title {}
1164setlegend $box $graph(legend)
1165
1166#frame .a -bd 8 -relief groove
1167frame .a -bd 2 -relief groove
1168
1169pack [menubutton .a.file -text File -underline 0 -menu .a.file.menu] -side left
1170menu .a.file.menu
1171pack [menubutton .a.plot -text "Plot Contents" -underline 0 -menu .a.plot.menu] -side left
1172menu .a.plot.menu
1173#.a.file.menu add cascade -label Tickmarks -menu .a.file.menu.tick
1174if {$expnam != ""} {
1175    .a.file.menu add command -label "Reload from EXP" \
1176            -command "getprofiles $expnam; plotdata $box"
1177}
1178if {$program == "absplt"} {
1179    .a.file.menu add cascade -label "Edit Abs Params" -menu .a.file.menu.edit
1180} else {
1181    .a.file.menu add command -label "Add New Curve" -command NewProfileValues
1182    .a.file.menu add cascade -label "Edit Curve" -menu .a.file.menu.edit
1183}
1184#.a.file.menu add command -label "Make PostScript" -command makepostscriptout
1185menu .a.file.menu.edit
1186.a.file.menu add cascade -label "Export plot" -menu .a.file.menu.export
1187menu .a.file.menu.export
1188.a.file.menu.export add command -label "Make PostScript" \
1189    -command makepostscriptout
1190if {$blt_version > 2.3 && $blt_version != 8.0} {
1191    source [file join $expgui(scriptdir) graceexport.tcl]
1192    .a.file.menu.export add command -label "to Grace" -command exportgrace
1193}
1194.a.file.menu.export add command -label "as .csv file" \
1195        -command makecsvfile
1196.a.file.menu add command -label Quit -command "destroy ."
1197pack [menubutton .a.options -text Options -underline 0 -menu .a.options.menu] \
1198        -side left   
1199menu .a.options.menu
1200if {$program == "absplt"} {
1201    .a.options.menu add radiobutton -label "2Theta/Tof/Eng" -value tt \
1202            -variable graph(plotunits) \
1203            -command "plotdata $box"
1204} else {
1205    .a.options.menu add radiobutton -label "2Theta" -value tt \
1206            -variable graph(plotunits) \
1207            -command "plotdata $box"
1208    .a.options.menu add command -label "Set Equiv. Wavelength" \
1209            -command "seteqwave $box"
1210}
1211.a.options.menu add radiobutton -label "d-space" -value d \
1212        -variable graph(plotunits) \
1213        -command "plotdata $box"
1214.a.options.menu add radiobutton -label "Q" -value q \
1215        -variable graph(plotunits) \
1216        -command "plotdata $box"
1217.a.options.menu add checkbutton -label "Include legend" \
1218        -variable graph(legend) \
1219        -command {setlegend $box $graph(legend)}
1220.a.options.menu add command -label "Set PS output" \
1221        -command setpostscriptout
1222.a.options.menu add command -label "Save Options" -underline 1 \
1223        -command "SaveOptions"
1224
1225pack [menubutton .a.help -text Help -underline 0 -menu .a.help.menu] -side right
1226menu .a.help.menu -tearoff 0
1227.a.help.menu add command -command aboutwidplot -label About
1228
1229pack .a -side top -fill both
1230pack $box -fill both -expand yes
1231
1232#----------------------------------------------------------------
1233# OK now go get the profile info
1234getprofiles $expnam
1235#----------------------------------------------------------------
1236
1237    trace variable newmenu(opt) w setoptmsg
1238
1239proc setoptmsg {args} {
1240    global newmenu
1241    array set opttxt {
1242        0 "Cylindrical samples, Lobanov & Alte da Veiga (TOF, CW, synch.)"
1243        1 "Simple linear (TOF)"
1244        2 "Surface Roughness, Pitschke, Hermann & Muttern (Bragg-Brentano)"
1245        3 "Surface Roughness, Suortti (Bragg-Brentano)"
1246        4 "Flat plate, transmission mode"
1247    }
1248    set newmenu(opttxt) ""
1249    catch {set newmenu(opttxt) [set opttxt($newmenu(opt))]}
1250}
1251set datanum 0
1252# seems to be needed in OSX
1253update
1254wm geom . [winfo reqwidth .]x[winfo reqheight .]
1255#
1256donewaitmsg
Note: See TracBrowser for help on using the repository browser.