source: trunk/widplt @ 797

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

# on 2004/05/13 23:48:46, toby did:
add open console
deal with starkit problems

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