+
+ clearlists
+ pollfile
+}
+
+proc for_lw {args} {
+ global lw_ls lw_ws
+ set body [lindex $args end]
+ set args [lreplace $args end end]
+ uplevel 1 [list \
+ foreach l $lw_ls \
+ w $lw_ws] \
+ $args \
+ [list $body]
+}
+
+set e_life 120
+set tint_switch 90
+set tint_switched [expr { exp( -($tint_switch+0.0) / $e_life ) }]
+
+proc retint {} {
+ global times e_life retint_after otherevent prtimes
+ catch { after cancel $retint_after }
+ set i 0
+ set now [clock seconds]
+ set latest $otherevent
+ set newprtimes {}
+ foreach time $times {
+ set age [expr {$now-$time}]
+ if {!$time} {
+ lappend newprtimes {}
+ } elseif {$age < 120} {
+ lappend newprtimes [format "%3ds" $age]
+ } else {
+ lappend newprtimes [format "%3dm" [expr {$age/120}]]
+ }
+ set latest [expr { $time > $latest ? $time : $latest }]
+ set tint [expr { exp( (-($age >= 0 ? $age : 0) + 0.0) / $e_life ) }]
+puts "AGE $age LA $latest TI $tint"
+ tintentries .msg $i $tint
+ incr i
+ }
+ set prtimes $newprtimes
+ set next [expr { ($now - $latest < 10 ? 10 :
+ $now - $latest > 3000 ? 3000 :
+ $now - $latest
+ ) * 10 }]
+#puts "nexting $latest $now $next"
+ set retint_after [after $next retint]
+}
+
+proc tintentries {ws y tint} {
+ global tint_switched
+ #puts "$tint $tint_switched"
+ set yellow [format "%02x" [expr {round( 255 *
+ ( $tint >= $tint_switched ? $tint : 0 )
+ )}]]
+ set black [format "%02x" [expr {round( 255 *
+ ( $tint >= $tint_switched ? 0 : ($tint / $tint_switched)*0.75 + 0.25 )
+ )}]]
+ set fg [format "#${black}${black}${black}"]
+ set bg [format "#${yellow}${yellow}00"]
+ foreach w $ws { $w itemconfigure $y -foreground $fg -background $bg }
+}
+
+proc clearlists {} {
+ global height otherevent
+ global times prtimes pirates messages
+ set currentfile {}
+
+ for_lw { $w delete 0 end; set $l {} }
+ set ntimes {}
+ set prtimes {}
+ for {set i 0} {$i<$height} {incr i} {
+ for_lw { lappend $l {}; $w insert end {} }
+ lappend ntimes 0
+ lappend prtimes {}
+ }
+ set times $ntimes
+ set otherevent [clock seconds]
+ retint
+}
+
+proc showtints {} {
+ global e_life
+ set divs 20
+ listbox .tints -width 60 -height [expr {$divs+1}]
+ for {set y 0} {$y <= $divs} {incr y} {
+ set tint [expr {($y+0.0)/$divs}]
+ .tints insert end \
+ "[format "#%2d %6f %4ds" $y $tint [expr {round(
+ $tint > 0 ? -log($tint) * $e_life : "9999"
+ )}]] The quick brown fox jumped over the lazy dog"
+ tintentries .tints $y $tint
+ }
+ pack .tints -side bottom
+}
+
+proc file-read-lines {lvar body} {
+ upvar 1 $lvar l
+ global logfile poll_after lastactivity bufdata
+
+#puts f-r-l
+ if {![info exists logfile]} {
+ return
+ }
+ while 1 {
+ if {[catch { read $logfile } got]} {
+ file-error $got
+ return
+ }
+#puts "f-r-l [string length $got]"
+ if {![string length $got] && [eof $logfile]} {
+ set ago [expr { [clock seconds] - $lastactivity }]
+ set interval [expr {( $ago < 10 ? 10 :
+ $ago > 3000 ? 3000 :
+ $ago ) * 10}]
+#puts "requeue filepoll $interval"
+ set poll_after [after $interval pollfile]
+ return
+ }
+ set lastactivity [clock seconds]
+
+ while {[regexp {^(.*?)[\r\n]+(.*)$} $got dummy lhs rhs]} {
+ set l "$bufdata$lhs"
+ set bufdata {}
+ set got $rhs
+puts ">>$l<<"
+ uplevel 1 $body
+ }
+ append bufdata $got
+ }
+}
+
+proc file-error {emsg} {
+ global logfile
+
+ shownotice red "Error reading logfile $currentfile:\n$emsg"
+ catch { close $logfile }
+ catch { unset logfile }
+}
+
+proc pollfile {} {
+ global poll_after logfile currentfile
+ global errorCode errorInfo bufdata lastactivity
+
+ catch { after cancel $poll_after }
+ if {![string length $currentfile]} {
+ shownotice red "No log file selected. Use File / Open."
+ return
+ }
+ if {![info exists logfile]} {
+ set bufdata {}
+ set lastactivity [clock seconds]
+ if {[catch { set logfile [open $currentfile r] } emsg]} {
+ shownotice red "Error opening logfile $currentfile:\n$emsg"
+ return
+ }
+ shownotice \#000080 "Reading $currentfile"
+ if {[catch {
+ seek $logfile -1024 end
+ } emsg]} {
+ if {![string match {POSIX EINVAL *} $errorCode]} {
+ file-error $emsg
+ }
+ }
+ file-read-lines l { }
+ }
+ file-read-lines l {
+ hidenotice
+ if {[regexp {^\[\d+:\d+:\d+\] (.*)} $l dummy rhs]} {
+puts PROCLINE
+ process-line $rhs
+ }
+ }
+}
+
+proc process-line {l} {
+ if {[regexp {^(\w+) tells ye, \"(.*)\"$} $l dummy pirate msg]} {
+puts "MESSAGE $l"
+ message $pirate $msg
+ }