source: trunk/liveplot @ 153

#!/usr/local/bin/wish
# $Id: liveplot 153 2009-12-04 23:01:17Z toby $
set Revision {$Revision: 153 $ $Date: 2009-12-04 23:01:17 +0000 (Fri, 04 Dec 2009) $}

bind all <Control-KeyPress-c> {destroy .}
# process command line arguments
set exitstat 0
set expnam [lindex $argv 0]
if {$expnam == ""} {puts "error -- no experiment name"; set exitstat 1}
if $exitstat {
    puts "usage: $argv0 expnam \[hist #\] \[legend\]"
    destroy .
}
if {[lindex $argv 1] == ""} {
    set hst 1
} else {
    set hst [lindex $argv 1]
}
if {[lindex $argv 2] == ""} {
    set graph(legend) 1
} else {
    set graph(legend) [lindex $argv 2]
}

set graph(backsub) 0

if {$tcl_platform(platform) == "windows"} {
    set graph(printout) 1
    set expgui(tcldump) tcldump.exe
} else {
    set graph(printout) 0
    set expgui(tcldump) tcldump
}

# default values
set graph(outname) out.ps
set graph(outcmd) lpr
set xunits {}
set yunits {}
set graph(xunits) 0
set graph(yunits) 0
set expgui(debug) 0
catch {if $env(DEBUG) {set expgui(debug) 1}}
#set expgui(debug) 1
set expgui(lblfontsize) 15
set expgui(fadetime) 10
set expgui(hklbox) 1
set expgui(autotick) 0
set expgui(pixelregion) 5
set peakinfo(obssym) scross
set peakinfo(obssize) 1.0
# create a set of markers for each phase
for {set i 1} {$i < 10} {incr i} {
    set peakinfo(flag$i) 0
    set peakinfo(max$i) Inf
    set peakinfo(min$i) -Inf
    set peakinfo(dashes$i) 1
}

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}
# option for coloring markers: note that GH keeps changing how to do this!
# also element -mapped => -show
if {$blt_version < 2.3 || $blt_version >= 8.0} {
    # version 8.0 is ~same as 2.3
    set graph(MarkerColorOpt) -fg 
    # mapped is needed in 8.0, both are OK in 2.3
    set graph(ElementShowOption) "-mapped 1"
    set graph(ElementHideOption) "-mapped 0"
} elseif {$blt_version >= 2.4} {
    set graph(MarkerColorOpt) -outline
    set graph(ElementShowOption) "-hide 0"
    set graph(ElementHideOption) "-hide 1"
} else {
    set graph(MarkerColorOpt) -color
    set graph(ElementShowOption) "-mapped 1"
    set graph(ElementHideOption) "-mapped 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 donewaitmsg {} {
    catch {destroy .wait}
    update
}

waitmsg "Loading histogram, Please wait"

#--------------------------------------------------------------
# define constants
array set peakinfo {
    color1 magenta 
    color2 cyan 
    color3 yellow 
    color4 sienna 
    color5 orange 
    color6 DarkViolet 
    color7 HotPink 
    color8 salmon 
    color9 LimeGreen
}
set cycle -1
set modtime 0

#----------------------------------------------------------------
# where are we?
set expgui(script) [info script]
# translate links -- go six levels deep
foreach i {1 2 3 4 5 6} {
    if {[file type $expgui(script)] == "link"} {
        set link [file readlink $expgui(script)]
        if { [file  pathtype  $link] == "absolute" } {
            set expgui(script) $link
        } {
            set expgui(script) [file dirname $expgui(script)]/$link
        }
    } else {
        break
    }
}

# fixup relative paths
if {[file pathtype $expgui(script)] == "relative"} {
    set expgui(script) [file join [pwd] $expgui(script)]
}
set expgui(scriptdir) [file dirname $expgui(script) ]
set expgui(gsasdir) [file dirname $expgui(scriptdir)]
set expgui(gsasexe) [file join $expgui(gsasdir) exe]

# called by a trace on expgui(lblfontsize)
proc setfontsize {a b c} {
    global expgui graph
    catch {
        font config lblfont -size [expr -$expgui(lblfontsize)]
        # this forces a redraw of the plot by changing the title to itself
        .g configure -title [.g cget -title]
    }
}
# define a font used for labels
if {$tcl_version >= 8.0} {
    font create lblfont -family Helvetica -size [expr -$expgui(lblfontsize)]
    trace variable expgui(lblfontsize) w setfontsize
}

proc readdata {box} { 
    global expgui
    if [catch {
        set loadtime [time {
            if {$expgui(tcldump) == ""} {
                readdata_hst $box
            } else {
                readdata_tcl $box
            }
        }]
        if $expgui(debug) {
            tk_dialog .time "Timing info" \
                    "Histogram loading took $loadtime" "" 0 OK
        }
    } errmsg] {
        if $expgui(debug) {
            catch {console show}
            error $errmsg
        }
        $box config -title "Read error"
        tk_dialog .err "Read Error" "Read Error -- $errmsg" \
                error 0 OK
        update
    }
}
   
proc readdata_hst {box} {
    global expgui expnam reflns
    global lasthst
    global hst peakinfo xunits
    $box config -title "(Histogram update in progress)"
    update
    # parse the output of a file
    set lasthst $hst
###########################################################################
#       set input [open histdump.inp w]
#       puts $input "$hst"
#       close $input
#       set input [open "| $expgui(gsasexe)/hstdump $expnam  < histdump.inp" w+]
###########################################################################
    # use histdump for right now
    set input [open histdump$hst.inp w]
    puts $input "$expnam"
    puts $input "L"
    puts $input "$hst"
    puts $input "0"
    close $input
    # use hstdmp without an experiment name so that output 
    # is not sent to the .LST file
    set input [open "| $expgui(gsasexe)/hstdmp < histdump$hst.inp" r]
    
    # initalize arrays
    set num -1
    set xlist {}
    set obslist {}
    set calclist {}
    set bcklist {}
    set xunits {}
    # define a list of reflection positions for each phase
    for {set i 1} {$i < 10} {incr i} {
        set reflns($i) {}
    }
    set i 0
    while {[gets $input line] >= 0} {
        incr i
        # run update every 50th line
        if {$i > 50} {set i 0; update}
        if [scan $line %d num] {
            if {$num > 0} {
                set Ispec 0
                set X -999
                scan [string range $line 8 end] %e%e%e%e%e%e \
                        X Iobs Icalc Ispec fixB fitB
                #puts $line
                # eliminate excluded points
                if {$Ispec > 0.0 && $X >= 0} {
                    lappend xlist $X
                    lappend obslist $Iobs
                    lappend calclist $Icalc
                    lappend bcklist [expr $fixB + $fitB]
                }
                # add peaks to peak lists
                #    puts "[string range $line 6 6]"
                # is this 6 or 7; 6 on win & 7 on SGI
                if [regexp {[1-9]} [string range $line 6 7] ph] {
                    lappend reflns($ph) $X
                }
            } 
        } else {
            regexp {Time|Theta|keV} $line xunits
        }
    }
    if {$xunits == "Theta"} {set xunits "2-Theta"}
    close $input
    catch {file delete histdump$hst.inp}
    xvec set $xlist
    obsvec set $obslist
    calcvec set $calclist
    bckvec set $bcklist
    diffvec set [obsvec - calcvec]
    global obsvec calcvec diffvec 
    set maxdiff  [set diffvec(max)]
    set cmin [set calcvec(min)]
    set omin [set obsvec(min)]
    set cmax [set calcvec(max)]
    set omax [set obsvec(max)]
    set expgui(min) [expr $omin < $cmin ? $omin : $cmin]
    set expgui(max) [expr $omax > $cmax ? $omax : $cmax]
    set ymin1 [expr $cmin - 1.1*$maxdiff]
    set ymin2 [expr $omin - 1.1*$maxdiff]
    if {$ymin1 < $ymin2} {
        diffvec set [diffvec + $ymin1]
    } {
        diffvec set [diffvec + $ymin2]
    }
    plotdata $box
}

proc readdata_tcl {box} {
    global expgui expnam reflns
    global lasthst graph
    global hst peakinfo xunits yunits
    $box config -title "(Histogram update in progress)"
    update
    # parse the output of a file
    set lasthst $hst
    # use tcldump
    set input [open histdump$hst.inp w]
    puts $input "$hst"
    # x units -- native
    puts $input "$graph(xunits)" 
    # y units  -- native
    puts $input "$graph(yunits)" 
    # format (if implemented someday)
    puts $input "0" 
    close $input
    # initalize arrays
    set X {}
    set OBS {}
    set CALC {}
    set BKG {}
    global refhkllist refphaselist refpos
    set refpos {}
    set refhkllist {}
    set refphaselist {}
    for {set i 1} {$i < 10} {incr i} {
        set reflns($i) {}
    }
    eval [exec $expgui(tcldump) $expnam < histdump$hst.inp]
    catch {file delete histdump$hst.inp}
    if {$X == ""} {
        $box config -title "(Error reading Histogram $hst)"
        foreach elem [$box element show] {
           eval $box element config $elem $graph(ElementHideOption)
        }
        return
    }
    foreach elem [$box element names] {
        eval $box element config $elem $graph(ElementShowOption)
    }
    xvec set $X
    obsvec set $OBS
    calcvec set $CALC
    bckvec set $BKG
    refposvec set $refpos
    diffvec set [obsvec - calcvec]
    if $graph(backsub) {
        obsvec set [obsvec - bckvec]
        calcvec set [calcvec - bckvec]
    }
    global obsvec calcvec diffvec 
    set maxdiff  [set diffvec(max)]
    set cmin [set calcvec(min)]
    set omin [set obsvec(min)]
    set cmax [set calcvec(max)]
    set omax [set obsvec(max)]
    set expgui(min) [expr $omin < $cmin ? $omin : $cmin]
    set expgui(max) [expr $omax > $cmax ? $omax : $cmax]
    set ymin1 [expr $cmin - 1.1*$maxdiff]
    set ymin2 [expr $omin - 1.1*$maxdiff]
    if {$ymin1 < $ymin2} {
        diffvec set [diffvec + $ymin1]
    } {
        diffvec set [diffvec + $ymin2]
    }
    
    plotdata $box
}

proc lblhkl {plot x} {
    global blt_version expgui tcl_platform tcl_version
    global refhkllist refphaselist peakinfo refpos
    # look for peaks within pixelregion pixels
    set xmin [$plot xaxis invtransform [expr $x - $expgui(pixelregion)]]
    set xmax [$plot xaxis invtransform [expr $x + $expgui(pixelregion)]]
    set peaknums [refposvec search $xmin $xmax]
    set peaklist {}
    set xcen 0
    # select by displayed phases
    set lbls 0
    if {$expgui(hklbox)} {
        catch {
            toplevel .hkl
            text .hkl.txt -width 30 -height 10 -wrap none \
                    -yscrollcommand ".hkl.yscroll set" 
            scrollbar .hkl.yscroll -command ".hkl.txt yview"
            grid .hkl.txt -column 0 -row 1 -sticky nsew
            grid .hkl.yscroll -column 1 -row 1 -sticky ns
            grid columnconfigure .hkl 0 -weight 1
            grid rowconfigure .hkl 1 -weight 1
            wm title .hkl "Liveplot HKL Labels"
            wm iconname .hkl HKL
            .hkl.txt insert end "Phase\thkl\tPosition"
        }
    }
    foreach peak $peaknums {
        if {$expgui(hklbox)} {
            catch {
                .hkl.txt insert end "\n[lindex $refphaselist $peak]"
                .hkl.txt insert end "\t[lindex $refhkllist $peak]"
                .hkl.txt insert end "\t[lindex $refpos $peak]"
                .hkl.txt see end
            }
        }
        if [set peakinfo(flag[lindex $refphaselist $peak])] {
            set xcen [expr $xcen + [refposvec range $peak $peak]]
            lappend peaklist [lindex $refhkllist $peak]
            incr lbls
        }
    }
    if {$peaklist == ""} return
    set xcen [expr $xcen / $lbls]
    # avoid bug in BLT 2.3 where Inf does not work for text markers
    if {$blt_version == 2.3} {
        set ycen [lindex [$plot yaxis limits] 1]
    } else  {
        set ycen Inf
    }
    if {$tcl_platform(platform) == "windows"} {
        # at least right now, text can't be rotated in windows
        regsub -all { } $peaklist "\n" peaklist
        set mark [$plot marker create text -coords "$xcen $ycen" \
        -text $peaklist -anchor n -bg "" -name hkl$xcen]
    } else {
        set mark [$plot marker create text -coords "$xcen $ycen" \
        -rotate 90 -text $peaklist -anchor n -bg "" -name hkl$xcen]
    }
    if {$tcl_version >= 8.0} {
        $plot marker config hkl$xcen -font lblfont
    }
    if {$expgui(fadetime) > 0} {
        catch {
            after [expr $expgui(fadetime) * 1000 ] \
            "catch \{ $plot marker delete $mark \}"
        }
    }
}

proc delallhkllbl {plot} {
    catch {
        eval $plot marker delete [$plot marker names hkl*]
    }
}

proc plotdata {box} {
    global expnam hst peakinfo xunits yunits cycle reflns modtime
    global lasthst graph expgui

    # is there a new histogram to load?
    if {$hst != $lasthst} {
        xvec set {}
        xvec notify now
        set cycle -1
        set modtime 0
        $box config -title "Please wait: loading histogram $hst"
        update
        return
    }
    xvec notify now
    obsvec notify now
    calcvec notify now
    bckvec notify now
    diffvec notify now
    $box config -title "$expnam cycle $cycle Hist $hst"
    $box xaxis config -title $xunits
    $box yaxis config -title $yunits
    setlegend $box $graph(legend)
    # reconfigure the obs data
    $box element configure obs \
            -symbol $peakinfo(obssym) \
            -pixels [expr 0.125 * $peakinfo(obssize)]i
    # now deal with peaks
    for {set i 1} {$i < 10} {incr i} {
        if {$expgui(autotick)} {
            set div [expr ( $expgui(max) - $expgui(min) )/40.]
            set ymin [expr $expgui(min) - ($i+1) * $div]
            set ymax [expr $expgui(min) - $i * $div]
        } else {
            set ymin $peakinfo(min$i)
            set ymax $peakinfo(max$i)
        }
        set j 0
        if [set peakinfo(flag$i)] {
            foreach X $reflns($i) {
                incr j
                catch {
                    $box marker create line -name peaks${i}_$j 
                }
                $box marker config peaks${i}_$j  -under 1 \
                        -coords "$X $ymin $X $ymax" 
                catch {
                    $box marker config peaks${i}_$j \
                            $graph(MarkerColorOpt) [list $peakinfo(color$i)]
                    if $peakinfo(dashes$i) {
                        $box marker config peaks${i}_$j -dashes "5 5"
                    }
                }
            }
            # $box element config phase$i -mapped  1
            catch {$box element create phase$i}
            catch {
                $box element config phase$i -color $peakinfo(color$i) 
            }
        } else {
            eval $box marker delete [$box marker names peaks${i}_*]
            eval $box element delete [$box element names phase$i]
        }
    }
    # force an update of the plot as BLT may not
    $box config -title [$box cget -title]
    update
}

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
        }
    }
}

proc minioptionsbox {num} {
    global blt_version tcl_platform peakinfo expgui
    set bx .opt$num
    catch {destroy $bx}
    toplevel $bx
    wm iconname $bx "Phase $num options"
    wm title $bx "Phase $num options"

    set i $num
    pack [label $bx.0 -text "Phase $i reflns" ] -side top
    pack [checkbutton $bx.1 -text "Show reflections" \
            -variable peakinfo(flag$i)] -side top 
    # remove option that does not work
    if {$blt_version != 8.0 || $tcl_platform(platform) != "windows"} {
        pack [checkbutton $bx.2 -text "Use dashed line" \
                -variable peakinfo(dashes$i)] -side top 
    }
    if !$expgui(autotick) {
        pack [frame $bx.p$i -bd 2 -relief groove] -side top
        #       pack [checkbutton $bx.p$i.0 -text "Show phase $i reflns" \
                #               -variable peakinfo(flag$i)] -side left -anchor w
        pack [label $bx.p$i.1 -text "  Y min:"] -side left
        pack [entry $bx.p$i.2 -textvariable peakinfo(min$i) -width 5] \
                -side left
        pack [label $bx.p$i.3 -text "  Y max:"] -side left
        pack [entry $bx.p$i.4 -textvariable peakinfo(max$i) -width 5] \
                -side left
    }
    pack [frame $bx.c$i -bd 2 -relief groove] -side top
    
    pack [label $bx.c$i.5 -text " color:"] -side left
    pack [entry $bx.c$i.6 -textvariable peakinfo(color$i) -width 12] \
            -side left
    pack [button $bx.c$i.2 -bg $peakinfo(color$i) -state disabled] -side left
    pack [button $bx.c$i.1 -text "Color\nmenu" \
            -command "setcolor $i"] -side left
    pack [frame $bx.b] -side top
    #pack [button $bx.b.1 -command {plotdata $box} -text "Update Plot"] \
            #    -side left
    pack [button $bx.b.4 -command "destroy $bx" -text Close ] -side right
}

proc setcolor {num} {
    global peakinfo
    set color [tk_chooseColor -initialcolor $peakinfo(color$num) -title "Choose color"]
    if {$color == ""} return
    set peakinfo(color$num) $color
}

proc makepostscriptout {} {
    global graph box
    if !$graph(printout) {
        set out [open "| $graph(outcmd) >& 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 liveplot.msg r]
            if {$msg != ""} {append msg "\n"}
            append msg [read $out]
            close $out
            catch {file delete 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 setpostscriptout {} {
    global graph tcl_platform
    set box .out
    catch {destroy $box}
    toplevel $box
    focus $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 setlblopts {} {
    global expgui tcl_platform tcl_version
    set box .out
    catch {destroy $box}
    toplevel $box
    focus $box
    pack [frame $box.c] -side top  -anchor w
    pack [label $box.c.l -text "HKL label\nerase time:"] -side left
    pack [entry $box.c.e -textvariable expgui(fadetime) -width 8] \
            -side left
    pack [label $box.c.l1 -text seconds] -side left
    pack [frame $box.d] -side top  -anchor w
    pack [label $box.d.l -text "HKL label size:"] -side left
    pack [entry $box.d.e -textvariable expgui(lblfontsize) -width 4] \
            -side left
    pack [label $box.d.l1 -text pixels] -side left
    # old versions if tcl/tk don't support the font command
    if {$tcl_version < 8.0} {
        $box.d.l config -fg #888
        $box.d.e config -fg #888 -state disabled
        $box.d.l1 config -fg #888
    }
    pack [frame $box.f] -side top  -anchor w
    pack [label $box.f.l -text "HKL search region:"] -side left
    pack [entry $box.f.e -textvariable expgui(pixelregion) -width 3] \
            -side left
    pack [label $box.f.l1 -text pixels] -side left
    pack [frame $box.e] -side top  -anchor w
    pack [checkbutton $box.e.b -text "Separate window for HKL labels"\
            -variable expgui(hklbox)] -side left
    pack [button $box.a -text "Close" -command "destroy $box"] -side top
}

proc setsymopts {} {
    global expgui peakinfo
    set box .out
    catch {destroy $box}
    toplevel $box
    focus $box
    pack [frame $box.d] -side left -anchor n
    pack [label $box.d.t -text "Symbol type"] -side top
    set expgui(obssym) $peakinfo(obssym) 
    set expgui(obssize) $peakinfo(obssize) 
    foreach symbol {square circle diamond plus cross \
            splus scross} \
            symbol_name {square circle diamond plus cross \
            thin-plus thin-cross} {
        pack [radiobutton $box.d.$symbol \
                -text $symbol_name -variable expgui(obssym) \
                -value $symbol] -side top -anchor w
    }
    pack [frame $box.e] -side left -anchor n -fill y
    pack [label $box.e.l -text "Symbol Size"] -side top
    pack [scale $box.e.s -variable expgui(obssize) \
            -from .1 -to 3 -resolution 0.05] -side top
    pack [frame $box.a] -side bottom
    pack [button $box.a.1 -text "Apply" -command { \
            if {$peakinfo(obssym) != $expgui(obssym)} {set peakinfo(obssym) $expgui(obssym)}; \
            if {$peakinfo(obssize) != $expgui(obssize)} {set peakinfo(obssize) $expgui(obssize)} \
        } ] -side left
    pack [button $box.a.2 -text "Close" -command "destroy $box"] -side left
}

# save some of the global options in ~/.gsas_config
proc SaveOptions {} {
    global graph expgui peakinfo
    set fp [open [file join ~ .gsas_config] a]
    puts $fp "set graph(legend) $graph(legend)"
    puts $fp "set graph(printout) $graph(printout)"
    puts $fp "set graph(outname) $graph(outname)"
    puts $fp "set graph(outcmd) $graph(outcmd)"
    puts $fp "set expgui(lblfontsize) $expgui(lblfontsize)"
    puts $fp "set expgui(fadetime) $expgui(fadetime)" 
    puts $fp "set expgui(hklbox) $expgui(hklbox)"
    puts $fp "set peakinfo(obssym) $peakinfo(obssym)"
    puts $fp "set peakinfo(obssize) $peakinfo(obssize)"
    puts $fp "set expgui(pixelregion) $expgui(pixelregion)"
    puts $fp "set expgui(autotick) $expgui(autotick)"
    close $fp
}

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

proc getcycle {} {
    global expnam
    set cycle -1
    catch {
        set fp [open $expnam.EXP r]
        set text [read $fp]
        close $fp
        regexp {GNLS  RUN.*Total cycles run *([0-9]*) } $text x cycle
    }
    return $cycle
}

proc updateifnew {} {
    global cycle modtime expnam
    if {[file mtime $expnam.EXP] != $modtime} {
        set modtime [file mtime $expnam.EXP]
        set newcycle [getcycle]
        if {$newcycle != $cycle} {
            set cycle $newcycle
            # delay one second
            # after 1000
            readdata .g
        }
    }
    # check every second
    after 1000 updateifnew 
}

proc plotdataupdate {array element action} {
    global box peakinfo reflns graph
    # parse the element
    regexp {([a-z]*)([0-9]*)} $element junk var num
    if {$var == "color"} {
        if {$peakinfo($element) == ""} return
        if [catch {
            .opt$num.c$num.2 config -bg $peakinfo($element)
        } ] return
        set i $num
        set j 0
        if [set peakinfo(flag$i)] {
            catch {
                $box element config phase$i -color $peakinfo(color$i) 
            } 
            foreach X $reflns($i) {
                incr j
                catch {
                    $box marker config peaks${i}_$j \
                            $graph(MarkerColorOpt) [list $peakinfo(color$i)]
                }
            }
        }
        return
    }
    waitmsg {Updating}
    plotdata $box
    donewaitmsg
}

# override options with locally defined values
if [file exists [file join $expgui(scriptdir) localconfig]] {
    source [file join $expgui(scriptdir) localconfig]
}
if [file exists [file join ~ .gsas_config]] {
    source [file join ~ .gsas_config]
}

if [file executable [file join $expgui(gsasexe) $expgui(tcldump)]] {
    set expgui(tcldump) [file join $expgui(gsasexe) $expgui(tcldump)]
#    puts "got tcldump"
} else {
    set expgui(tcldump) {}
#    puts "no tcldump"
}

# vectors
vector xvec
xvec notify never
vector obsvec 
obsvec notify never
vector calcvec
calcvec notify never
vector bckvec 
bckvec notify never
vector diffvec 
diffvec notify never
vector refposvec
refposvec notify never
# create the graph
if [catch {
    set box [graph .g]
} errmsg] {
    tk_dialog .err "BLT Error" \
"BLT Setup Error: could not create a graph (msg: $errmsg). \
There is a problem with the setup of BLT on your system.
See the expgui.html file for more info." \
            error 0 "Quit"
exit
}
if [catch {
    Blt_ZoomStack $box
} errmsg] {
    tk_dialog .err "BLT Error" \
"BLT Setup Error: could not access a Blt_ routine (msg: $errmsg). \
The pkgIndex.tcl is probably not loading bltGraph.tcl.
See the expgui.html file for more info." \
            error 0 "Limp ahead"
}
$box element create obs -color black -linewidth 0 \
        -symbol $peakinfo(obssym) \
        -pixels [expr 0.125 * $peakinfo(obssize)]i
$box element create calc -color red  -symbol none  
$box element create diff -color blue  -symbol none  
$box element config obs -xdata xvec -ydata obsvec
$box element config calc -xdata xvec -ydata calcvec
$box element config diff -xdata xvec -ydata diffvec
if {$expgui(tcldump) != ""} {
    $box element create bckg -color green  -symbol none  
    $box element config bckg -xdata xvec -ydata bckvec
    bind . <Shift-Button-1> "lblhkl $box %x"
    bind . <Key-h> "lblhkl $box %x"
    bind . <Key-H> "lblhkl $box %x"
#    bind $box <Shift-Double-Button-1> "lblallhkl %W"
    bind $box <Shift-Button-3> "delallhkllbl %W"
}
$box yaxis config -title {} 
setlegend $box $graph(legend)

updateifnew
frame .a -bd 3 -relief groove
pack [menubutton .a.file -text File -underline 0 -menu .a.file.menu] -side left
menu .a.file.menu
.a.file.menu add cascade -label Tickmarks -menu .a.file.menu.tick
menu .a.file.menu.tick
foreach num {1 2 3 4 5 6 7 8 9} {
    .a.file.menu.tick add checkbutton -label "Phase $num" \
            -variable  peakinfo(flag$num) \
            -command {plotdata $box}
}
.a.file.menu add cascade -label "Histogram" -menu .a.file.menu.hist
menu .a.file.menu.hist
for {set num 1} {$num < 99} {incr num 10} {
    .a.file.menu.hist add cascade -label "$num-[expr $num+9]" \
            -menu .a.file.menu.hist.$num
    menu .a.file.menu.hist.$num
    for {set num1 $num} {$num1 < 10+$num} {incr num1} {
        .a.file.menu.hist.$num add radiobutton -label $num1 -value $num1 \
                -variable hst \
                -command {set cycle [getcycle];readdata .g}
    }
}
.a.file.menu add command -label "Update Plot" \
        -command {set cycle [getcycle];readdata .g}
.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 cascade -label "Configure Tickmarks" -menu .a.options.menu.tick
menu .a.options.menu.tick
.a.options.menu.tick add radiobutton -label "Manual Placement" \
        -value 0 -variable expgui(autotick) -command "plotdata $box"
.a.options.menu.tick add radiobutton -label "Auto locate" \
        -value 1 -variable expgui(autotick) -command "plotdata $box"
.a.options.menu.tick add separator
foreach num {1 2 3 4 5 6 7 8 9} {
    .a.options.menu.tick add command -label "Phase $num" \
            -command "minioptionsbox $num"
}
.a.options.menu add command -label "Obs symbol" -command setsymopts
if {$expgui(tcldump) != ""} {
    .a.options.menu add cascade -label "X units" -menu .a.options.menu.xunits
    menu .a.options.menu.xunits
    .a.options.menu.xunits add radiobutton -label "As collected" \
            -variable graph(xunits) -value 0 \
            -command {set cycle [getcycle];readdata .g}
    .a.options.menu.xunits add radiobutton -label "d-space" \
            -variable graph(xunits) -value 1 \
            -command {set cycle [getcycle];readdata .g}
    .a.options.menu.xunits add radiobutton -label "Q" \
            -variable graph(xunits) -value 2 \
            -command {set cycle [getcycle];readdata .g}
    .a.options.menu add cascade -label "Y units" -menu .a.options.menu.yunits
    menu .a.options.menu.yunits
    .a.options.menu.yunits add radiobutton -label "As collected" \
            -variable graph(yunits) -value 0 \
            -command {set cycle [getcycle];readdata .g}
    .a.options.menu.yunits add radiobutton -label "Normalized" \
            -variable graph(yunits) -value 1 \
            -command {set cycle [getcycle];readdata .g}
    .a.options.menu add command -label "HKL labeling" -command setlblopts
    .a.options.menu add checkbutton -label "Subtract background" \
            -variable graph(backsub) \
            -command {set cycle [getcycle];readdata .g}
}
    
.a.options.menu add checkbutton -label "Include legend" \
        -variable graph(legend) \
        -command {setlegend $box $graph(legend)}
.a.options.menu add command -label "Set PS output" -command setpostscriptout
.a.options.menu add command -label "Save Options" -underline 1 \
        -command "SaveOptions"

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 aboutliveplot -label About

pack .a -side top -fill both
pack $box -fill both -expand yes

# add the extra options
set fl [file join $expgui(scriptdir) icddcmd.tcl]
if [file exists $fl] {source $fl}
set fl [file join $expgui(scriptdir) cellgen.tcl]
if [file exists $fl] {source $fl}

donewaitmsg
trace variable peakinfo w plotdataupdate