#!/usr/local/bin/wish
set Revision {$Revision: 8 $ $Date: 2009-12-04 22:58:49 +0000 (Fri, 04 Dec 2009) $}
bind all <Control-KeyPress-c> {destroy .}
# hope for the best
set gsasexe {/usr/local/gsas}
if {[lindex $argv 0] != ""} {set gsasexe [lindex $argv 0]}
set expnam [file root [lindex $argv 1]]
#if {$expnam == ""} {puts "error -- no experiment name"; destroy .}
if [catch {package require BLT} errmsg] {
    tk_dialog .err "BLT Error" "Error -- Unable to load the BLT package" \
	    error 0 Quit
    destroy .
}

# handle Tcl/Tk v8+ where BLT is in a namespace
#  use the command so that it is loaded
catch {blt::graph}
catch {
    namespace import blt::graph
    namespace import blt::vector
}
# old versions of blt don't report a version number
if [catch {set blt_version}] {set blt_version 0}

proc waitmsg {message} {
    set w .wait
    # kill any window/frame with this name
    catch {destroy $w}
    pack [frame $w]
    frame $w.bot -relief raised -bd 1
    pack $w.bot -side bottom -fill both
    frame $w.top -relief raised -bd 1
    pack $w.top -side top -fill both -expand 1
    label $w.msg -justify left -text $message -wrap 3i
    catch {$w.msg configure -font \
                -Adobe-Times-Medium-R-Normal--*-180-*-*-*-*-*-*
    }
    pack $w.msg -in $w.top -side right -expand 1 -fill both -padx 3m -pady 3m
    label $w.bitmap -bitmap info
    pack $w.bitmap -in $w.top -side left -padx 3m -pady 3m
    update 
}

proc donewait {} {
    catch {destroy .wait}
    update
}

if {$expnam != ""} {waitmsg "Loading $expnam.EXP, Please wait"}

# read an EXP file into an array
proc expload {file} {
    global exparray gsasexe
    if [catch {
	set fil [open $file r]
    }] {return 1}
    set len [gets $fil line]
    # is this a direct access file?
    if {$len > 160} {
	close $fil
	# use convdtos because tcl can't handle null characters
	if ![file executable $gsasexe/convdtos] {
        tk_dialog .err \
		"Warning" "Warning -- Unable to read direct access EXP file, convdtos not found." \
	    error 0 Continue
	  return
	}
	set fil [open "| $gsasexe/convdtos < $file" r]
	set len [gets $fil line]
    }
    while {$len > 0} {
	set key [string range $line 0 11]
	set exparray($key) [string range $line 12 end]
	set len [gets $fil line]
    }
    close $fil
    return 0
}

proc readexp {key} {
    global exparray
    # truncate long keys & pad short ones
    set key [string range "$key          " 0 11]
    if [catch {set val $exparray($key)}] return
    return $val
}

# get profile information out from a EXP file
proc getprofiles {} {
    global datalist wave XY UVWP lblarr ttrange
    set nhist [string trim [readexp { EXPR  NHST }]]
    set n 0
    # get the histogram types
    for {set i 0} {$i < $nhist} {incr i} {
	if {[expr $i % 12] == 0} {
	    incr n
	    set line [readexp " EXPR  HTYP$n"]
	}
	set ihist [expr $i + 1]
	set htype($ihist) [lindex $line $i]
    }
    for {set i 0} {$i < $nhist} {incr i} {
	set ihist [expr $i + 1]
	set line [lrange $line 1 end]

	# process powder data only
	if {[string range $htype($ihist) 0 0] != "P"} continue
	# for now skip TOF data as well
	if {[string range $htype($ihist) 2 2] != "C"} continue
	set line [readexp "HST  $ihist NPHAS"]

	# loop over phases
	set iph 0
	foreach flag $line {
	    incr iph
	    if !$flag continue
	    # wavelength
	    set line [readexp "HST  $ihist ICONS"]
	    set lambda1 [lindex $line 0]
	    # data range
	    set drange [readexp "HST  $ihist TRNGE"]
	    set key [format %s%1d%2d%s HAP $iph $ihist PRCF]
	    set line [readexp $key]
	    set ptype [lindex $line 0]
	    set pterms  [lindex $line 1]
	    set it 0
	    set line {}
	    while {$it < ($pterms+3)/4} {
		set key [format %s%1d%2d%s%2d HAP $iph $ihist PRCF $it]
		append line [readexp $key]
		incr it
	    }
	    set key "H${ihist}P$iph"
	    lappend datalist $key
	    set lblarr($key) "Histogram $ihist Phase $iph"
	    set wave($key) $lambda1
	    set ttrange($key) $drange
	    if {$ptype == 1} {
		set UVWP($key) "[lrange $line 0 2] 0"
		set XY($key) {0 0}
	    } elseif {$ptype == 2} {
		set UVWP($key) "[lrange $line 0 2] [lindex $line 8]"
		set XY($key) [lrange $line 3 4]
	    } elseif {$ptype == 3} {
		set UVWP($key) "[lrange $line 0 3]"
		set XY($key) [lrange $line 4 5]
	    }
	}
    }
}

proc makepostscriptout {} {
    global graph box
    if !$graph(printout) {
	set out [open "| $graph(outcmd) >& /tmp/liveplot.msg" w]
	catch {
	    puts $out [$box postscript output -landscape 1 \
		-decorations no -height 7.i -width 9.5i]
	    close $out
	} msg
	catch {
	    set out [open /tmp/liveplot.msg r]
	    if {$msg != ""} {append msg "\n"}
	    append msg [read $out]
	    close $out
	    file delete /tmp/liveplot.msg
	}
	if {$msg != ""} {
	    tk_dialog .msg "file created" \
		    "Postscript file processed with command \
		    $graph(outcmd). Result: $msg" "" 0 OK
	} else {
	    tk_dialog .msg "file created" \
		    "Postscript file processed with command \
		    $graph(outcmd)" "" 0 OK
	}
    } else {
	$box postscript output $graph(outname) -landscape 1 \
		-decorations no -height 7.i -width 9.5i    
	tk_dialog .msg "file created" \
		"Postscript file $graph(outname) created" "" 0 OK
    }
}

proc setprintopt {page} {
    global graph
    if $graph(printout) { 
	$page.4.1 config -fg black
	$page.4.2 config -fg black -state normal
	$page.6.1 config -fg #888 
	$page.6.2 config -fg #888 -state disabled
    } else {
	$page.4.1 config -fg #888 
	$page.4.2 config -fg #888 -state disabled
	$page.6.1 config -fg black
	$page.6.2 config -fg black -state normal
    }
}

proc seteqwave {top} {
    global equivwave
    set box .wave
    catch {destroy $box}
    toplevel $box
    focus $box
    grab $box
    pack [frame $box.1] -side top 
    pack [label $box.1.a -text "Equivalent wavelength:"] -side top 
    pack [entry $box.1.b -textvariable equivwave] -side top 
    pack [frame $box.2] -side top 
    pack [button $box.2.c -text Clear -command "set equivwave {}; destroy $box"]
    pack [button $box.2.u -text Use -command "destroy $box"]
    tkwait window $box
    plotdata $top
}

proc setpostscriptout {} {
    global graph tcl_platform
    set box .out
    catch {destroy $box}
    toplevel $box
    focus $box
    grab $box
    pack [frame $box.4] -side top -anchor w -fill x
    pack [checkbutton $box.4.a -text "Write PostScript files" \
	    -variable graph(printout) -offvalue 0 -onvalue 1 \
	    -command "setprintopt $box"] -side left -anchor w
    pack [entry $box.4.2 -textvariable graph(outname)] -side right -anchor w
    pack [label $box.4.1 -text "PostScript file name:"] -side right -anchor w
    pack [frame $box.6] -side top -anchor w -fill x
    pack [checkbutton $box.6.a -text "Print PostScript files" \
	    -variable graph(printout) -offvalue 1 -onvalue 0 \
	    -command "setprintopt $box" ] -side left -anchor w
    pack [entry $box.6.2 -textvariable graph(outcmd)] -side right -anchor w
    pack [label $box.6.1 -text "Command to print files:"] -side right -anchor w

    pack [button $box.a -text "Close" -command "destroy $box"] -side top    
    if {$tcl_platform(platform) == "windows"} {
	set graph(printout) 1
	$box.4.a config -state disabled
	$box.6.a config -fg #888 -state disabled
    }
    setprintopt $box
}

proc aboutwidplot {} {
    global Revision
    tk_dialog .warn About "
GSAS\n\
A. C. Larson and\n R. B. Von Dreele,\n LANSCE, Los Alamos\n\n\
WIDPLT\nB. Toby, NIST\nNot subject to copyright\n\n\
$Revision\n\
" {} 0 OK
}

proc nextcolor {var} {
    set num [uplevel "incr $var"]
    return [lindex {red green blue cyan magenta yellow} [expr $num % 6]]
}

proc newmenu {} {
    global newmenu datanum
    incr datanum
    set base .new
    catch {destroy $base}
    toplevel $base
    focus $base
    grab $base
    wm title $base {Enter a new profile}
    label $base.label#7 -text Gaussian
    label $base.label#8 -text Lorentz
    label $base.label#1 -text U
    label $base.label#2 -text V
    label $base.label#3 -text W
    label $base.label#4 -text P
    label $base.label#5 -text X
    label $base.label#6 -text Y
    entry $base.entry#1 -textvariable newmenu(U) -width 8
    entry $base.entry#2 -textvariable newmenu(V) -width 8
    entry $base.entry#3 -textvariable newmenu(W) -width 8
    entry $base.entry#4 -textvariable newmenu(P) -width 8
    entry $base.entry#5 -textvariable newmenu(X) -width 8
    entry $base.entry#6 -textvariable newmenu(Y) -width 8

    label $base.label#9 -text label
    entry $base.entry#7 -textvariable newmenu(label)
    
    label $base.label#11 -text {2Theta Min}
    entry $base.entry#9 -textvariable newmenu(min) -width 6
    label $base.label#12 -text {2Theta Max}
    entry $base.entry#10 -textvariable newmenu(max) -width 6
    
    label $base.label#13 -text Wavelength

    entry $base.entry#11 -textvariable newmenu(wave) -width 8
    
    button $base.button#1 -text Add -command "addopt; destroy $base"
    button $base.button#2 -text Quit -command "destroy $base"
    
    # Geometry management

    grid $base.label#7 -in $base	-row 2 -column 1  -columnspan 4
    grid $base.label#8 -in $base	-row 2 -column 6  -columnspan 2
    grid $base.label#1 -in $base	-row 3 -column 1 
    grid $base.label#2 -in $base	-row 3 -column 2 
    grid $base.label#3 -in $base	-row 3 -column 3 
    grid $base.label#4 -in $base	-row 3 -column 4 
    grid $base.label#5 -in $base	-row 3 -column 6 
    grid $base.label#6 -in $base	-row 3 -column 7 
    grid $base.entry#1 -in $base	-row 4 -column 1 
    grid $base.entry#2 -in $base	-row 4 -column 2 
    grid $base.entry#3 -in $base	-row 4 -column 3 
    grid $base.entry#4 -in $base	-row 4 -column 4
    grid $base.entry#5 -in $base	-row 4 -column 6 
    grid $base.entry#6 -in $base	-row 4 -column 7 
    grid $base.label#9 -in $base	-row 5 -column 1 
    grid $base.entry#7 -in $base	-row 5 -column 2  -columnspan 3
    grid $base.label#13 -in $base	-row 5 -column 5  -columnspan 2
    grid $base.entry#11 -in $base	-row 5 -column 7 
    grid $base.label#11 -in $base	-row 6 -column 1 
    grid $base.entry#9 -in $base	-row 6 -column 2 
    grid $base.label#12 -in $base	-row 6 -column 3 
    grid $base.entry#10 -in $base	-row 6 -column 4 
    grid $base.button#1 -in $base	-row 6 -column 6 
    grid $base.button#2 -in $base	-row 6 -column 7 
    
    # Resize behavior management

    grid rowconfigure $base 2 -weight 1 -minsize 17
    grid rowconfigure $base 3 -weight 0 -minsize 19
    grid rowconfigure $base 4 -weight 0 -minsize 30
    grid rowconfigure $base 5 -weight 0 -minsize 30
    grid rowconfigure $base 6 -weight 0 -minsize 30
    grid columnconfigure $base 1 -weight 0 -minsize 26
    grid columnconfigure $base 2 -weight 0 -minsize 30
    grid columnconfigure $base 3 -weight 0 -minsize 30
    grid columnconfigure $base 4 -weight 0 -minsize 65
    grid columnconfigure $base 5 -weight 1 -minsize 26
    grid columnconfigure $base 6 -weight 0 -minsize 30
    grid columnconfigure $base 7 -weight 0 -minsize 30
    set newmenu(U) 0
    set newmenu(V) 0
    set newmenu(W) 0
    set newmenu(P) 0
    set newmenu(X) 0
    set newmenu(Y) 0
    set newmenu(min) 5
    set newmenu(max) 100
    set newmenu(label) "Curve #$datanum"
    set newmenu(wave) 1.5418
}

proc addopt {} {
    global newmenu datanum lblarr display UVWP XY datalist ttrange wave
    set key new$datanum
    set UVWP($key) [list $newmenu(U) $newmenu(V) $newmenu(W) $newmenu(P)]
    set XY($key) [list $newmenu(X) $newmenu(Y)]
    set lblarr($key) $newmenu(label)
    set ttrange($key) "$newmenu(min) $newmenu(max)"
    set wave($key) $newmenu(wave)
    lappend datalist $key
    .a.plot.menu add checkbutton -label $lblarr($key) \
	    -command {plotdata $box} -variable display($key)
}

proc editmenu {} {
    global newmenu datalist lblarr
    set base .edit
    catch {destroy $base}
    toplevel $base
    focus $base
    grab $base
    wm title $base {Edit a profile}
    label $base.label#7 -text Gaussian
    label $base.label#8 -text Lorentz
    label $base.label#1 -text U
    label $base.label#2 -text V
    label $base.label#3 -text W
    label $base.label#4 -text P
    label $base.label#5 -text X
    label $base.label#6 -text Y
    entry $base.entry#1 -textvariable newmenu(U) -width 8
    entry $base.entry#2 -textvariable newmenu(V) -width 8
    entry $base.entry#3 -textvariable newmenu(W) -width 8
    entry $base.entry#4 -textvariable newmenu(P) -width 8
    entry $base.entry#5 -textvariable newmenu(X) -width 8
    entry $base.entry#6 -textvariable newmenu(Y) -width 8

    label $base.label#9 -text {Select an option} 
    set llist {}
    foreach item $datalist {lappend llist $lblarr($item)}
    eval tk_optionMenu $base.entry#7 newmenu(opt) $llist

    label $base.label#11 -text {2Theta Min}
    entry $base.entry#9 -textvariable newmenu(min) -width 6
    label $base.label#12 -text {2Theta Max}
    entry $base.entry#10 -textvariable newmenu(max) -width 6
    
    label $base.label#13 -text Wavelength

    entry $base.entry#11 -textvariable newmenu(wave) -width 8

    button $base.button#1 -text Save -command "saveopt"
    button $base.button#2 -text Quit -command "destroy $base"
    
    # Geometry management

    grid $base.label#9 -in $base	-row 1 -column 1  -columnspan 2 \
	    -sticky e
    grid $base.entry#7 -in $base	-row 1 -column 3  -columnspan 3 \
	    -sticky w
    grid $base.label#7 -in $base	-row 2 -column 1  -columnspan 4
    grid $base.label#8 -in $base	-row 2 -column 6  -columnspan 2
    grid $base.label#1 -in $base	-row 3 -column 1 
    grid $base.label#2 -in $base	-row 3 -column 2 
    grid $base.label#3 -in $base	-row 3 -column 3 
    grid $base.label#4 -in $base	-row 3 -column 4 
    grid $base.label#5 -in $base	-row 3 -column 6 
    grid $base.label#6 -in $base	-row 3 -column 7 
    grid $base.entry#1 -in $base	-row 4 -column 1 
    grid $base.entry#2 -in $base	-row 4 -column 2 
    grid $base.entry#3 -in $base	-row 4 -column 3 
    grid $base.entry#4 -in $base	-row 4 -column 4
    grid $base.entry#5 -in $base	-row 4 -column 6 
    grid $base.entry#6 -in $base	-row 4 -column 7 
    grid $base.label#13 -in $base	-row 5 -column 5  -columnspan 2
    grid $base.entry#11 -in $base	-row 5 -column 7 
    grid $base.label#11 -in $base	-row 6 -column 1 
    grid $base.entry#9 -in $base	-row 6 -column 2 
    grid $base.label#12 -in $base	-row 6 -column 3 
    grid $base.entry#10 -in $base	-row 6 -column 4 
    grid $base.button#1 -in $base	-row 6 -column 6 
    grid $base.button#2 -in $base	-row 6 -column 7 

    # Resize behavior management
    
    grid rowconfigure $base 1 -weight 0 -minsize 30
    grid rowconfigure $base 2 -weight 1 -minsize 17
    grid rowconfigure $base 3 -weight 0 -minsize 19
    grid rowconfigure $base 4 -weight 0 -minsize 30
    grid rowconfigure $base 5 -weight 0 -minsize 30
    grid rowconfigure $base 6 -weight 0 -minsize 30
    grid columnconfigure $base 1 -weight 0 -minsize 26
    grid columnconfigure $base 2 -weight 0 -minsize 30
    grid columnconfigure $base 3 -weight 0 -minsize 30
    grid columnconfigure $base 4 -weight 0 -minsize 65
    grid columnconfigure $base 5 -weight 1 -minsize 26
    grid columnconfigure $base 6 -weight 0 -minsize 30
    grid columnconfigure $base 7 -weight 0 -minsize 30
    set newmenu(U) {}
    set newmenu(V) {}
    set newmenu(W) {}
    set newmenu(P) {}
    set newmenu(X) {}
    set newmenu(Y) {}
    set newmenu(min) {}
    set newmenu(max) {}
    set newmenu(label) {}
    set newmenu(wave) {}
    set newmenu(opt) {}
}

proc saveopt {} {
    global newmenu datanum lblarr display UVWP XY datalist ttrange wave box
    set key {}
    foreach item $datalist {
	if {$lblarr($item) == $newmenu(opt)} {set key $item; break}
    }
    if {$key == ""} return
    set UVWP($key) [list $newmenu(U) $newmenu(V) $newmenu(W) $newmenu(P)]
    set XY($key) [list $newmenu(X) $newmenu(Y)]
    set ttrange($key) "$newmenu(min) $newmenu(max)"
    set wave($key) $newmenu(wave)
    plotdata $box
}

proc loadopt {a1 a2 a3} {
    global newmenu lblarr display UVWP XY datalist ttrange newmenu wave
    set key {}
    foreach item $datalist {
	if {$lblarr($item) == $newmenu(opt)} {set key $item; break}
    }
    if {$key == ""} return
    set newmenu(U) [lindex $UVWP($key) 0]
    set newmenu(V) [lindex $UVWP($key) 1]
    set newmenu(W) [lindex $UVWP($key) 2]
    set newmenu(P) [lindex $UVWP($key) 3]
    set newmenu(X) [lindex $XY($key) 0]
    set newmenu(Y) [lindex $XY($key) 1]
    set newmenu(min) [lindex $ttrange($key) 0]
    set newmenu(max) [lindex $ttrange($key) 1]
    set newmenu(wave) $wave($key)
}

proc plotdata {graph} {
    global UVWP XY wave lblarr datalist display plotunits ttrange equivwave
    if {$plotunits == "d"} {
	$graph xaxis configure -title "d (A)"
    } elseif {$plotunits == "q"} {
	$graph xaxis configure -title "Q (A-1)"
    } elseif {$equivwave == ""} {
	$graph xaxis configure -title "2Theta"
    } else {
	$graph xaxis configure -title "2Theta @ $equivwave"
    }
    $graph yaxis configure -min 0 
    $graph xaxis configure -min 0
    # delete all graphs
    eval $graph element delete [$graph element names]
    set num -1
    foreach item $datalist {
	if {$display($item)} {
	    if {[expr [lindex $XY($item) 0] + [lindex $XY($item) 1]] != 0} {
		set lflag 1
	    } else {
		set lflag 0
	    }
	    set ttlist {}
	    set fwhmlist {}
	    set lfwhmlist {}
	    set tfwhmlist {}
	    # loop over two-theta
	    for     {set tt [lindex $ttrange($item) 0]} \
		    {$tt <= [lindex $ttrange($item) 1]} \
		    {set tt [expr $tt + 4]} {
		set lfwhm 0
		if {$plotunits == "d"} {
		    lappend ttlist [tt2d $wave($item) $tt ]
		    set gfwhm [deltad $wave($item) $tt \
			    [eval FWHM $tt $UVWP($item)]]
		    lappend fwhmlist $gfwhm
		    if $lflag {
			set lfwhm [deltad $wave($item) $tt \
				[eval LFWHM $tt $XY($item)]]
			lappend lfwhmlist $lfwhm
		    }
		} elseif {$plotunits == "q"} {
		    lappend ttlist [tt2Q $wave($item) $tt ]
		    set gfwhm [deltaQ $wave($item) $tt \
			    [eval FWHM $tt $UVWP($item)]]
		    lappend fwhmlist $gfwhm
		    if $lflag {
			set lfwhm [deltaQ $wave($item) $tt \
			    [eval LFWHM $tt $XY($item)]]
			lappend lfwhmlist $lfwhm
		    }
		} elseif {$equivwave == ""} {
		    lappend ttlist $tt
		    set gfwhm [eval FWHM $tt $UVWP($item)]
		    lappend fwhmlist $gfwhm
		    if $lflag {
			set lfwhm [eval LFWHM $tt $XY($item)]
			lappend lfwhmlist $lfwhm
		    }
		} else {
		    set tteq [ttequiv $wave($item) $tt $equivwave]
		    if {$tteq != ""} {
			lappend ttlist $tteq
			set gfwhm [delta2teq $wave($item) $tt \
				[eval FWHM $tt $UVWP($item)] $equivwave]
			lappend fwhmlist $gfwhm
			if $lflag {
			    set lfwhm [delta2teq $wave($item) $tt \
				    [eval LFWHM $tt $XY($item)] $equivwave]
			    lappend lfwhmlist $lfwhm
			}
		    }
		}
		# assume FWHM add as square roots
		lappend tfwhmlist \
			[expr sqrt($gfwhm*$gfwhm + $lfwhm*$lfwhm)]
	    }
	    if $lflag {
		catch {
		    $graph element create ${item}G -label "$lblarr($item) G" 
		}
		$graph element config ${item}G \
		    -xdata $ttlist -ydata $fwhmlist -linewidth 3 \
		    -color [nextcolor num]
		catch {
		    $graph element create ${item}L -label "$lblarr($item) L"
		}
		$graph element config ${item}L \
			-xdata $ttlist -ydata $lfwhmlist -linewidth 3 \
			-color [nextcolor num]
	    }
	    catch {
		$graph element create $item -label $lblarr($item) 
	    }
	    $graph element config $item \
		    -xdata $ttlist -ydata $tfwhmlist -linewidth 3 \
		    -color [nextcolor num]
	}
    }
}
#-------------------------------------------------------------------------
# converts 2theta(deg) to Q (A-1)
proc tt2Q {lambda twotheta} {
    set pi 3.14159
    set torad [expr $pi / 360.]
    return [expr 4 * $pi / ($lambda) * sin (($twotheta) * $torad)]
}

# converts Q (A-1) to 2theta(deg)
proc Q2tt {lambda Q} {
    set pi 3.14159
    set todeg [expr 360. / $pi]
    set asinarg [expr ($lambda) * $Q * 0.25 / $pi]
    if {$asinarg <= 1} {
	return [expr $todeg * asin ($asinarg)]
    }
    return {}
}

# converts a FWHM in 2theta(deg) to a FWHM in Q (A-1)
proc deltaQ {lambda twotheta FWHM} {
    return [expr [tt2Q $lambda $twotheta+($FWHM/2.)] - \
	         [tt2Q $lambda $twotheta-($FWHM/2.)] ]
}

# converts 2theta(deg) to d (A)
proc tt2d {lambda twotheta} {
    set pi 3.14159
    set torad [expr $pi / 360.]
    return [expr 0.5 * ($lambda) / sin (($twotheta) * $torad)]
}

# converts d (A) to 2theta(deg)
proc d2tt {lambda d} {
    set pi 3.14159
    set todeg [expr 360. / $pi]
    set asinarg [expr ($lambda) * 0.5 / $d]
    if {$asinarg <= 1} {
	return [expr $todeg * asin ($asinarg)]
    }
    return {}
}

# converts a FWHM in 2theta(deg) to a FWHM in Q (A-1)
proc deltad {lambda twotheta FWHM} {
    return [expr [tt2d $lambda $twotheta-($FWHM/2.)] - \
	         [tt2d $lambda $twotheta+($FWHM/2.)] ]
}

# computes an equivalent 2theta at a different wavelength
proc ttequiv {lambda twotheta lambda_eq} {
    return [Q2tt $lambda_eq [tt2Q $lambda $twotheta]]
}

# converts a FWHM in 2theta(deg) to a FWHM at in 2theta 
# at a different wavelength
proc delta2teq {lambda twotheta FWHM lambda_eq} {
    return [expr [Q2tt $lambda_eq [tt2Q $lambda $twotheta+($FWHM/2.)]] - \
	         [Q2tt $lambda_eq [tt2Q $lambda $twotheta-($FWHM/2.)]] ]
}

proc FWHM {tt U V W P} {
    set pi 3.14159
    set torad [expr $pi / 360.]
    # tan theta
    set tantt [expr tan($tt * $torad ) ]
    set costt [expr cos($tt * $torad ) ]
    return [expr sqrt \
	    (8.* log(2) * ($U * $tantt * $tantt + $V * $tantt + $W \
	    + $P / ($costt * $costt))) / 100.]
}
proc LFWHM {tt X Y} {
    set pi 3.14159
    set torad [expr $pi / 360.]
    # tan theta
    set tantt [expr tan($tt * $torad ) ]
    set costt [expr cos($tt * $torad ) ]
    return [expr ($X / $costt + $Y * $tantt) / 100.]
}

proc setlegend {box legend} {
    global blt_version
    if {$blt_version >= 2.3 && $blt_version < 8.0} {
	if $legend {
	    $box legend config -hide no
	} else {
	    $box legend config -hide yes
	}
    } else {
	if $legend {
	    $box legend config -mapped yes
	} else {
	    $box legend config -mapped no
	}
    }
}

trace variable newmenu(opt) w loadopt

set legend 0
set equivwave {}
set plotunits tt
if {$tcl_platform(platform) == "windows"} {
    set graph(printout) 1
} else {
    set graph(printout) 0
}
set graph(outname) out.ps
set graph(outcmd) lpr
set datalist {}

if {$expnam != ""} {
    if [expload $expnam.EXP] {
	tk_dialog .err "EXP Error" "Error -- Unable to read $expnam.EXP" \
		error 0 Quit
	destroy .
    }
    # OK now go get the profile info
    getprofiles
}

# get the location of the script but translate up to n levels of links
set scriptname [info script]
set i -1
while {[file type $scriptname] == "link"} {
    if {[incr i] >= 20} {
	puts "More than $i links for [info script], giving up"
	destroy .
    }
    if {[file pathtype [set link [file readlink $scriptname]]] == "absolute"} {
	set scriptname $link
    } {
	set scriptname [file dirname $scriptname]/$link
    }
}
set scriptdir [file dirname $scriptname]

foreach file [glob -nocomplain [file join $scriptdir widplt_*]] {
    source $file
}

# create the graph
set box [graph .g]
Blt_ZoomStack $box
Blt_ActiveLegend $box
Blt_ClosestPoint $box
$box config -title {}
$box yaxis config -title {FWHM} 
setlegend $box $legend
#frame .a -bd 8 -relief groove
frame .a -bd 2 -relief groove

pack [menubutton .a.file -text File -underline 0 -menu .a.file.menu] -side left
menu .a.file.menu
pack [menubutton .a.plot -text "Plot Contents" -underline 0 -menu .a.plot.menu] -side left
menu .a.plot.menu
#.a.file.menu add cascade -label Tickmarks -menu .a.file.menu.tick
if {$expnam != ""} {
    .a.file.menu add command -label "Reload from EXP" -command getprofiles
}
.a.file.menu add command -label "Add New Curve" -command newmenu
.a.file.menu add command -label "Edit Curve" -command editmenu
.a.file.menu add command -label "Make PostScript" -command makepostscriptout
.a.file.menu add command -label Quit -command "destroy ."
pack [menubutton .a.options -text Options -underline 0 -menu .a.options.menu] \
	-side left    
menu .a.options.menu
.a.options.menu add radiobutton -label "2Theta" -value tt -variable plotunits \
	-command "plotdata $box"
.a.options.menu add command -label "Set Equiv. Wavelength" -command "seteqwave $box"
.a.options.menu add radiobutton -label "d-space" -value d -variable plotunits \
	-command "plotdata $box"
.a.options.menu add radiobutton -label "Q" -value q -variable plotunits \
	-command "plotdata $box"
.a.options.menu add checkbutton -label "Include legend" -variable legend \
	-command {setlegend $box $legend}
.a.options.menu add command -label "Set PS output" -command setpostscriptout

pack [menubutton .a.help -text Help -underline 0 -menu .a.help.menu] -side right
menu .a.help.menu -tearoff 0
.a.help.menu add command -command aboutwidplot -label About

foreach item $datalist {
    .a.plot.menu add checkbutton -label $lblarr($item) \
	    -command {plotdata $box} -variable display($item)
}

pack .a -side top -fill both
pack $box -fill both -expand yes
set datanum 0
donewait