#!/usr/local/bin/wish
set Revision {$Revision: 53 $ $Date: 2009-12-04 22:59:37 +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]
}


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

# default values
set graph(outname) out.ps
set graph(outcmd) lpr

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!
if {$blt_version < 2.3 || $blt_version >= 8.0} {
    set graph(MarkerColorOpt) -fg 
} elseif {$blt_version >= 2.4} {
    set graph(MarkerColorOpt) -outline
} else {
    set graph(MarkerColorOpt) -color
}

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
}

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" } {
h	    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]


proc readdata {box} {
    global expgui expnam reflns
    global lasthst
    global hst peakinfo units
    $box config -title "(Histogram update in progress)"
    update
    # parse the output of a file
    if [catch {
	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 units {}
	# define a list of reflection positions for each phase
	for {set i 1} {$i < 10} {incr i} {
	    set reflns($i) {}
	    #	set flag$i 0
	}
	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 units
	    }
	}
	if {$units == "Theta"} {set units "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 ymin1 [expr [set calcvec(min)] - 1.1*$maxdiff]
	set ymin2 [expr [set obsvec(min)] - 1.1*$maxdiff]
	if {$ymin1 < $ymin2} {
	    diffvec set [diffvec + $ymin1]
	} {
	    diffvec set [diffvec + $ymin2]
	}
	plotdata $box
    } errmsg] {
	$box config -title "Read error: $errmsg"
	catch {console show}
	puts "error message: $errmsg"
	update
    }   
}

proc plotdata {box} {
    global expnam hst peakinfo units cycle reflns modtime
    global lasthst graph

    # 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 $units
    setlegend $box $graph(legend)
    # now deal with peaks
    set j 0
    for {set i 1} {$i < 10} {incr i} {
	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 $peakinfo(min$i) $X $peakinfo(max$i)" 
		$box marker config peaks${i}_$j \
			$graph(MarkerColorOpt) $peakinfo(color$i)
		if $peakinfo(dashes$i) {
		    catch {
			$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} {
    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 
	pack [checkbutton $bx.2 -text "Use dashed line" \
		-variable peakinfo(dashes$i)] -side top 
	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.1 -text "Color menu" \
		-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
}

# save some of the global options in ~/.gsas_config
proc SaveOptions {} {
    global graph
    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)"
    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 10000 updateifnew 
    after 1000 updateifnew 
}

# fetch EXP file processing routines 
source [file join $expgui(scriptdir) readexp.tcl]

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}

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

# 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
# create the graph
set box [graph .g]
Blt_ZoomStack $box
$box element create obs -color black -symbol scross -linewidth 0
$box element create calc -color red  -symbol none  
#$box element create bckg -color green  -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 bckg -xdata xvec -ydata bckvec
$box element config diff -xdata xvec -ydata diffvec
$box yaxis config -title {} 
setlegend $box $graph(legend)
# 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
}

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 "Histogram" -menu .a.file.menu.hist
menu .a.file.menu.hist
foreach num {1 2 3 4 5 6 7 8 9} {
    .a.file.menu.hist add radiobutton -label $num -value $num -variable hst \
	    -command {plotdata $box}
}
.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 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
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 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
donewait