#!/usr/local/bin/wish
set Revision {$Revision: 44 $ $Date: 2009-12-04 22:59:27 +0000 (Fri, 04 Dec 2009) $}
# display a .LST file in a text box
# updates 8/26 add bindings for page-up, -down, uparrow, downarrow
# read from gzip .LST.gz files using gunzip and then append the .LST file
# start work on plotting variables change next line to use 
set plotvars 0
set txtvw(menulength) 25
set txtvw(stringcount) 0
set txtvw(string) {}
set txtvw(sum) 0
# maximum characters to read initially from a .LST file
set txtvw(maxchars) 1000000
if {$tcl_platform(platform) == "windows"} {
   # windows is slow!
   set txtvw(maxchars) 200000
}
if {[set expnam [lindex $argv 0]] == ""} {
    tk_dialog .warn Notify "No filename specified" error 0 OK
    destroy .
}
set filename $expnam.LST
set zfil {}
set fil {}
# is there a compressed version of the file?
if {[file exists $filename.gz] && $tcl_platform(platform) != "windows"} {
    set zfil [open "|gunzip < $filename.gz" r]
}
set box {}
set txtvw(followcycle) 1

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}
}
waitmsg "Reading $expnam.LST, Please wait"

set txtvw(runnumber) 0

proc findcyc {win menu {pos 0.0}} {
    global txtvw valuelst
    set i 0
    set lastpos {}
    # loop over cycles
    set startpos $pos
    # get current cycle number
    set pos [$win search -regexp -count chars \
	    {Cycle *[0-9]+ +There} $pos+1line end]
    while {$pos != ""} {
	# add the current cycle number to the menu
	set line [lindex [split $pos .] 0]
	$win tag add cycle $line.1 $line.10
	incr i
	set cycle {}
	regexp {Cycle *([0-9]+) +There} [$win get $pos $line.end] x cycle
	if {$cycle != ""} {
	    set lastpos $pos
	    set txtvw(lastcycle) "Cycle $cycle"
	    .a.goto.menu entryconfigure 1 -state normal
	    $menu insert 1 command \
		    -font 6x12 \
		    -label "Cycle $cycle" \
		    -command "$win see $pos"
	    if {[$menu index end] > $txtvw(menulength)} {$menu delete end}
	}
	# get next cycle number
	set nextpos [$win search -regexp -count chars \
		{Cycle *[0-9]+ +There} $pos+1line end]
	if {$nextpos == ""} {
	    set epos end
	} else {
	    set epos $nextpos
	}

	# loop to highlight all Rwp & Rp values
	set npos $startpos
	set npos [$win search -regexp -count chars \
		{Hstgm *[0-9]+} $npos+1line $pos]
	while {$npos != ""} {
	    set line [lindex [split $npos .] 0]
	    set x [$win get $line.0 $line.end]
	    scan $x %s%d%s%d%d%f%f%f a hst c d e f rwp rp
	    lappend valuelst(Rwp$hst) $cycle $rwp
	    lappend valuelst(Rp$hst) $cycle $rp
	    $win tag add rval $npos $line.end
	    set npos [$win search -regexp -count chars \
		{Hstgm *[0-9]+} $npos+1line $pos]
	}
	# get the CHI**2 value
	set chipos [$win search {Reduced CHI**2 =} $pos $epos]
	if {$chipos != ""} {
	    $win tag add chi $chipos+8chars $chipos+23chars
	    set chi [string trim [$win get $chipos+16chars $chipos+23chars]]
	    set txtvw(lastchi) "Chi**2 $chi"
	    lappend valuelst(chi2) $cycle $chi
#	    puts "$cycle $chi"
	}
	set sumpos [$win search {Final sum} $pos $epos]
	if {$sumpos != ""} {
	    set finalshift [string trim [$win get $sumpos+42chars $sumpos+54chars]]
	    set txtvw(finalshift) "Shift $finalshift"
	    lappend valuelst(final_shft2) $cycle $finalshift
	}
	# loop to highlight all R(F**2) values
	set npos $pos
	set npos [$win search -regexp -count chars \
		{Histogram *[0-9]+} $npos+1line $epos]
	while {$npos != ""} {
	    set line [lindex [split $npos .] 0]
	    set x [$win get $line.0 $line.end]
	    regexp {gram *([0-9]+).*\) =(.*)} $x a hst rf2
	    lappend valuelst(Rbragg$hst) $cycle $rf2
	    $win tag add rval $npos $line.end
	    set npos [$win search -regexp -count chars \
		    {Histogram *[0-9]+} $npos+1line $epos]
	}
	# get ready to loop again
	set startpos $pos
	set pos $nextpos
    }
    if {$txtvw(followcycle) && $lastpos != ""} {$win see $lastpos}
}

proc findrun {win {menu ""} {pos 0.0}} {
    global txtvw
    while {$pos != ""} {
	set pos [$win search "Program GENLES" $pos+1line end]
        if {$menu != "" && $pos != ""} {
	    incr txtvw(runnumber)
	    .a.goto.menu entryconfigure 2 -state normal
	    $menu insert 1 command \
                    -font 6x12 \
                    -label "Run $txtvw(runnumber)" \
                    -command "$win see $pos"
	    if {[$menu index end] > $txtvw(menulength)} {$menu delete end}
	}
    }
}


proc findsum {win menu {pos 0.0}} {
    global txtvw
    set fpos [$win search {Final sum(} $pos+1line end]
    if {$fpos == ""} return
    set pos [$win search {Summary table} $fpos+1line end]
    while {$pos != ""} {
	set line [lindex [split $fpos .] 0]
	set x [$win get $line.0 $line.end]
	regexp {cycle *([0-9]+) is} $x a lstcyc
	incr txtvw(sum)
	.a.goto.menu entryconfigure 3 -state normal
	$menu insert 1 command \
		-font 6x12 \
		-label "Summary $txtvw(sum)" \
		-command "$win see $pos"
	if {[$menu index end] > $txtvw(menulength)} {$menu delete end}
	set line [lindex [split $pos .] 0]
	incr line
	set ncyc [string range [string trim [$win get $line.0 $line.end]] end end]
	while {[set x [$win get $line.0 $line.end]] != ""} {
	    incr line
	    set lbl [string trim [string range $x 0 8]]
	    if {$lbl != "Name" && [string range $x 0 0] != "1"} {
		# are there values here?
		set len [llength [set vals [string range $x 9 end]]]
		foreach val $vals {
		    if {[scan $val %f s] == 1} {
			lappend valuelst($lbl) [expr $lstcyc - $ncyc +1] $s
		    }
		}
	    }
	}
	set fpos [$win search {Final sum(} $pos+1line end]
        if {$fpos == ""} return
	set pos [$win search {Summary table} $fpos+1line end]
    }
}

proc findsetstring {win string {menu ""} {pos 0.0}} {
    global txtvw 
    while {$pos != ""} {
	set pos [$win search -regexp -count chars \
		$string $pos+1line end]
        if {$menu != "" && $pos != ""} {
	    $win tag add found $pos "$pos + $chars chars"
	    incr txtvw(stringcount)
	    $menu insert 1 command \
                    -font 6x12 \
                    -label "loc #$txtvw(stringcount)" \
                    -command "$win see $pos"
	    if {[$menu index end] > $txtvw(menulength)} {$menu delete end}
	}
    }
}

proc setsearchstring { } {
    global txtvw
    set txtvw(stringcount) 0
    .a.goto.menu entryconfigure 5 -state disabled -label ""
    .a.goto.menu.str delete 1 end
    catch {.txt tag delete found}
    .txt tag config found -foreground red
    if {[string trim $txtvw(entry)] == ""} {
	set txtvw(string) {}
	return
    } else {
	set txtvw(string) [string trim $txtvw(entry)]
    }
    findsetstring .txt $txtvw(string) .a.goto.menu.str
    if {$txtvw(stringcount) > 0} {
	.a.goto.menu entryconfigure 5 -state normal -label "$txtvw(string)..."
    }
}

proc updatetext {fil {repeat 1}} {
    global txtvw filename

    if $repeat {after 5000 updatetext $fil}
    set txt [read $fil]
    if {$txt == ""} return
    .txt config -state normal
    set oldend [.txt index end]
    # truncate the text if too long
    if {[string length $txt] > $txtvw(maxchars) && $repeat == 0} {
	set beg [expr [string length $txt] - $txtvw(maxchars)]
	.txt insert end "(first $beg characters in file skipped)\n"
	.txt insert end [string range $txt $beg end]
    } else {
	.txt insert end $txt
    }
    .txt config -state disabled
    update idletasks
    findrun .txt .a.goto.menu.run $oldend
    update
    findcyc .txt .a.goto.menu.cyc $oldend
    update
    findsum .txt .a.goto.menu.sum $oldend
    update
    
    if {$txtvw(string) != ""} {
	findsetstring .txt $txtvw(string) .a.goto.menu.str $oldend
	if {$txtvw(stringcount) > 0} {
	    .a.goto.menu entryconfigure 5 -state normal -label "$txtvw(string)..."
	}
    }
}
proc getstring {} {
    catch {destroy .str}
    toplevel .str
    grab .str
    pack [frame .str.1] -side top
    pack [frame .str.2] -side top
    pack [label .str.1.l -text "Search String"] -side left
    pack [entry .str.1.e -textvariable txtvw(entry) -width 12] -side left
    pack [label .str.1.2 -text "(regexp)"] -side left
    pack [button .str.2.ok -text "Search" -command \
	    "setsearchstring; destroy .str" ] -side left
    pack [button .str.2.q -text "Quit" -command \
	    "destroy .str" ] -side left
# bind to RETURN here    
#    bind .str 
}

proc findstring {win str1 {str2 ""}} {
    set pos [$win search -backwards $str1 end]
    if {$pos == "" && $str2 != ""} {
	set pos [$win search -backwards $str2 end]
    }
    if {$pos == ""} return
    $win see $pos
}

proc SaveOptions {} {
    global txtvw
    set fp [open [file join ~ .gsas_config] a]
    puts $fp "set txtvw(followcycle) $txtvw(followcycle)"
    close $fp
}

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

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


set txtvw(lastchi) {}
set txtvw(lastcycle) {}
set txtvw(finalshift) {}
text .txt -width 100 -wrap none \
	-yscrollcommand ".yscroll set" \
	-xscrollcommand ".xscroll set" 
if {$tcl_version >= 8.0} {.txt config -font Courier}
scrollbar .yscroll -command ".txt yview"
scrollbar .xscroll -command ".txt xview" -orient horizontal
grid .xscroll -column 0 -row 2 -sticky ew
grid .txt -column 0 -row 1 -sticky nsew
grid .yscroll -column 1 -row 1 -sticky ns
grid columnconfigure . 0 -weight 1
grid rowconfigure . 1 -weight 1
wm title . "View $filename"
wm iconname . $filename
grid [frame .a -bd 2 -relief raised] -column 0 -row 0 -columnspan 2 -sticky ew
pack [menubutton .a.file -text File -underline 0 -menu .a.file.menu] \
	    -side left
menu .a.file.menu
.a.file.menu add command -label Exit -command "destroy ."

pack [menubutton .a.goto -text "Go To" -underline 0 -menu .a.goto.menu] \
	    -side left
menu .a.goto.menu
.a.goto.menu add cascade -label "Cycle #"  -menu .a.goto.menu.cyc \
	-state disabled
menu .a.goto.menu.cyc
.a.goto.menu add cascade -label "Refinement Run #"  -menu .a.goto.menu.run \
	-state disabled
menu .a.goto.menu.run
.a.goto.menu add cascade -label "Summary #"  -menu .a.goto.menu.sum \
	-state disabled
menu .a.goto.menu.sum
.a.goto.menu add command -label "Set Search String" -command getstring 
#pack [button .but.lbl1 -text "Set Search String" -command getstring] -side left
.a.goto.menu add cascade -label ""  -menu .a.goto.menu.str -state disabled
menu .a.goto.menu.str

pack [menubutton .a.options -text "Options" -underline 0 \
	-menu .a.options.menu] \
	    -side left
menu .a.options.menu
.a.options.menu  add checkbutton -label "Auto Advance" -variable txtvw(followcycle) 
.a.options.menu add command -label "Save Options" -underline 1 \
	-command "SaveOptions"

if {$plotvars && ![catch {package require BLT}]} {
    pack [menubutton .a.plot -text "Plot" -underline 0 -menu .a.plot.menu ] \
	    -side left
    menu .a.plot.menu -postcommand postingvars
    .a.plot.menu add cascade -label "Variable(s)" -menu .a.plot.menu.vars
    menu .a.plot.menu.vars
}

proc postingvars {} {
    global valuelst
    .a.plot.menu.vars delete 1 end
    foreach var [lsort [array names valuelst]] {
	.a.plot.menu.vars add checkbutton -label $var -command plotvars \
		-variable plotlist($var)
    }
}
proc plotvars {} {
    global valuelst plotlist
    catch {
	toplevel .plot
	pack [graph .plot.g]
	Blt_ZoomStack .plot.g
	Blt_ActiveLegend .plot.g
	.plot.g config -title ""
	.plot.g xaxis config -title "cycle"
	.plot.g yaxis config -title ""
    }
    raise .plot
    .plot.g element delete *
    set num 0
    foreach var [lsort [array names valuelst]] {
	if $plotlist($var) {
	    incr num
	    set color [lindex {red green blue magenta cyan yellow} [expr $num % 6]]
	    .plot.g element create "$var" -data $valuelst($var) -color $color
	}
    }
}

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

grid [frame .but ] -column 0 -row 3 -columnspan 2 -sticky ew
pack [label .but.lbl2 -textvariable txtvw(lastcycle) -relief sunken] -side left
pack [label .but.lbl3 -textvariable txtvw(lastchi) -relief sunken] -side left
pack [label .but.lbl4 -textvariable txtvw(finalshift) -relief sunken] -side left
bind all <Control-KeyPress-c> {destroy .}
bind . <KeyPress-Prior> ".txt yview scroll -1 page"
bind . <KeyPress-Next> ".txt yview scroll 1 page"
bind . <KeyPress-Up> ".txt yview scroll -1 unit"
bind . <KeyPress-Down> ".txt yview scroll 1 unit"
bind . <KeyPress-Home> ".txt yview 0"
bind . <KeyPress-End> ".txt yview end"
#pack [button .but.q -text close -command "destroy ." ] -side right
.txt tag config cycle -background yellow
.txt tag config rval -background  green
.txt tag config chi -background  green
if [file exists $filename] {
    set fil [open $filename r]
} else {
    # create a file if it does not exist
    set fil [open $filename a+]
    close $fil
    set fil [open $filename r]
}
donewait
# read a file compressed file
if {$zfil != ""} {updatetext $zfil 0; close $zfil}
# read the initial file
updatetext $fil 0
# now start reading with updates
updatetext $fil 1