source: trunk/widplt @ 1028

Last change on this file since 1028 was 1028, checked in by toby, 10 years ago

fix FWHM calc

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