set lw_ws {.time .pirate .msg}
proc widgets {} {
- global height lw_ws
- listbox .time -width 5 -height $height -borderwidth 0 -background black
- listbox .pirate -width 14 -height $height -borderwidth 0 -background black
- listbox .msg -width 80 -height $height -borderwidth 0
+ global height lw_ws prtimes
+ listbox .time -width 5 -background black \
+ -listvariable prtimes -foreground white
+ listbox .pirate -width 14 -background black
+ listbox .msg -width 80
+ for_lw {
+ $w configure -height $height -borderwidth 0 -activestyle none \
+ -highlightthickness 0
+ }
eval pack $lw_ws -side left
label .overlay -relief raised -foreground white
}
}
proc newfile {} {
- global currentfile defaultfile
+ global currentfile defaultfile logfile
set newfile [tk_getOpenFile -multiple 0 -initialfile $currentfile \
-title "Select YPP log to track"]
if {![string length $newfile]} return
+ catch { close $logfile }
+ catch { unset logfile }
+
set currentfile $newfile
set newdefaults [open $defaultfile.new w]
puts $newdefaults "[list set currentfile $currentfile]"
pollfile
}
-proc for_lw {body} {
+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 \
- $body]
+ w $lw_ws] \
+ $args \
+ [list $body]
}
set e_life 120
set tint_switch 90
+set bell_again 60
set tint_switched [expr { exp( -($tint_switch+0.0) / $e_life ) }]
proc retint {} {
- global times e_life retint_after otherevent
+ 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 < 60} {
+ lappend newprtimes [format "%3ds" $age]
+ } elseif {$age < 3600} {
+ lappend newprtimes [format "%3dm" [expr {$age/60}]]
+ } else {
+ lappend newprtimes [format "%3dh" [expr {$age/3600}]]
+ }
set latest [expr { $time > $latest ? $time : $latest }]
- set tint [expr {
- exp( -($now >= $time ? $now-$time : 0) / $e_life )
- }]
+ 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
proc clearlists {} {
global height otherevent
- global times pirates messages
+ 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]
upvar 1 $lvar l
global logfile poll_after lastactivity bufdata
+#puts f-r-l
if {![info exists logfile]} {
return
}
file-error $got
return
}
- if {[eof $logfile]} {
+#puts "f-r-l [string length $got]"
+ if {![string length $got] && [eof $logfile]} {
set ago [expr { [clock seconds] - $lastactivity }]
- set poll_after [after [expr {( $ago < 10 ? 10 :
- $ago > 3000 ? 3000 :
- $ago ) * 100}] \
- pollfile]
+ 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]
- global bufdata
- if {![regexp {^(.*?)[\r\n]+(.*)$} $got dummy lhs rhs]} {
- append bufdata $got
- return
+ while {[regexp {^(.*?)[\r\n]+(.*)$} $got dummy lhs rhs]} {
+ set l "$bufdata$lhs"
+ set bufdata {}
+ set got $rhs
+#puts ">>$l<<"
+ uplevel 1 $body
}
-
- set l "$bufdata$lhs"
- set bufdata $rhs
-puts ">>$l<<"
- uplevel 1 $body
+ append bufdata $got
}
}
-proc with-file {body} {
- global errorInfo errorCode
- set rc [catch { uplevel 1 $body } result]
- switch -exact $rc {
- 0 {
- # ok
- return $result
- }
- 1 {
- # error
- shownotice red "Error reading logfile $currentfile:\n$emsg"
- catch { close $logfile }
- set logfile {}
- }
- default {
- # 2 - 3 - 4 return, break, continue
- return -code $rc $errorInfo $errorCode $result
- }
- 4 {
- #
- }
-
+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
file-read-lines l { }
}
file-read-lines l {
- process-line $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
+ }
+}
- with-file {
-
+proc message {pirate msg} {
+ global times pirates messages height
+ global lw_ls lw_ws bell_again
+
+ set ix [lsearch -exact $pirates $pirate]
+ set now [clock seconds]
+
+ if {$bell_again > -2 &&
+ ($ix<0 || [lindex $times $ix] < $now-$bell_again)} {
+ bell -nice
+ }
+ if {$ix < 0} {
+ set cix 0
+ set oldest $now
+ foreach time $times {
+ if {$time < $oldest} {
+ set oldest $time
+ set ix $cix
+ }
+ incr cix
}
-
- while 1 {
- set data read
+ for_lw {
+ set $l [lreplace [set $l] $ix $ix]
+ lappend $l {}
+ $w delete $ix
+ $w insert end {}
+ }
+ set ix [expr {$height-1}]
+ }
+ for_lw new [list $now $pirate $msg] {
+ set $l [lreplace [set $l] $ix $ix $new]
+ $w delete $ix
+ $w insert $ix $new
}
+#puts "TIMES $times"
+ .pirate itemconfigure $ix -foreground white
+ retint
}
proc parseargs {} {
foreach arg $argv {
if {![string compare $arg --test-tints]} {
showtints
+ } elseif {![string compare $arg --no-bell]} {
+ set bell_again -2
} else {
error "unknown option $arg"
}