}
set progname ypp-chatlog-alerter
+set height 5
-menu .mbar -tearoff 0
-foreach w {file edit} l {File Edit} {
- menu .mbar.$w -tearoff 0
- .mbar add cascade -menu .mbar.$w -label $l
-}
proc menuent {w l a x} {
set c [list .mbar.$w add command -label $l -command $x]
if {[string length $a]} { lappend c -accel Command-$a }
eval $c
}
-foreach l {Open Quit} a {O Q} x {newfile exit} {
- menuent file $l $a $x
-}
-foreach l {Cut Copy Paste Clear} a {X C V {}} {
- menuent edit $l $a [list event generate {[focus]} <<$l>>]]
-}
-. configure -menu .mbar
-
-switch -exact [tk windowingsystem] {
- aqua {
- set defaultfile ~/Library/Preferences/$progname.prefs
+proc menus {} {
+ global height
+
+ menu .mbar -tearoff 0
+ foreach w {file edit} l {File Edit} {
+ menu .mbar.$w -tearoff 0
+ .mbar add cascade -menu .mbar.$w -label $l
}
- x11 {
- set defaultfile ~/.$progname.rc
+ foreach l {Open Quit} a {O Q} x {newfile exit} {
+ menuent file $l $a $x
}
- default {
- error ?
+ foreach l {Cut Copy Paste Clear} a {X C V {}} {
+ menuent edit $l $a [list event generate {[focus]} <<$l>>]]
}
+ . configure -menu .mbar
}
-set height 5
+proc nonportability {} {
+ global progname defaultfile
+
+ switch -exact [tk windowingsystem] {
+ aqua {
+ set defaultfile ~/Library/Preferences/$progname.prefs
+ }
+ x11 {
+ set defaultfile ~/.$progname.rc
+ }
+ default {
+ error ?
+ }
+ }
+}
+
+set lw_ls {times pirates messages}
+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
+ eval pack $lw_ws -side left
+ label .overlay -relief raised -foreground white
+}
-listbox .t -width 5 -height $height -borderwidth 0
-listbox .p -width 14 -height $height -borderwidth 0
-listbox .m -width 80 -height $height -borderwidth 0
-pack .t .p .m -side left
+proc shownotice {colour message} {
+ .overlay configure -text $message -background $colour
+ place .overlay -relx 0.5 -rely 0.5 -anchor center
+}
+proc hidenotice {} {
+ place forget .overlay
+}
proc newfile {} {
global currentfile defaultfile
puts $newdefaults "[list set currentfile $currentfile]"
close $newdefaults
file rename -force $defaultfile.new $defaultfile
- refresh
+
+ clearlists
+ pollfile
}
-proc for_ll {varname body} {
- upvar 1 $varname l
- foreach l {times pirates messages} {
- set rc [catch { uplevel 1 $body } emsg]
- switch -exact $rc {
- 0 {
- # ok
- }
- 4 {
- # continue
- }
- 3 {
- # break
- return
- }
- default {
- # error, return, etc.
- return -code $rc -errorinfo $errorInfo \
- -errorcode $errorCode $emsg
- }
- }
- }
+proc for_lw {body} {
+ global lw_ls lw_ws
+ uplevel 1 [list \
+ foreach l $lw_ls \
+ w $lw_ws \
+ $body]
}
+set e_life 120
+set tint_switch 90
+set tint_switched [expr { exp( -($tint_switch+0.0) / $e_life ) }]
+
proc retint {} {
- global messages
+ global times e_life retint_after otherevent
+ catch { after cancel $retint_after }
set i 0
set now [clock seconds]
- foreach minfo $messages {
- manyset $minfo then pirate msg
- set !
+ set latest $otherevent
+ foreach time $times {
+ set latest [expr { $time > $latest ? $time : $latest }]
+ set tint [expr {
+ exp( -($now >= $time ? $now-$time : 0) / $e_life )
+ }]
+ tintentries .msg $i $tint
+ incr i
+ }
+ 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 init {} {
- global currentfile height
+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 pirates messages
set currentfile {}
- foreach w {t p m} { .$w delete 0 end }
- foreach l {times pirates messages}
+ for_lw { $w delete 0 end; set $l {} }
+ set ntimes {}
for {set i 0} {$i<$height} {incr i} {
- lappend times 0
- lappend pirates {}
- lappend messages {}
- foreach w {t p m} { .$w insert end {} }
+ for_lw { lappend $l {}; $w insert end {} }
+ lappend ntimes 0
+ }
+ 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
+
+ if {![info exists logfile]} {
+ return
+ }
+ while 1 {
+ if {[catch { read $logfile } got]} {
+ file-error $got
+ return
+ }
+ if {[eof $logfile]} {
+ set ago [expr { [clock seconds] - $lastactivity }]
+ set poll_after [after [expr {( $ago < 10 ? 10 :
+ $ago > 3000 ? 3000 :
+ $ago ) * 100}] \
+ pollfile]
+ return
+ }
+ set lastactivity [clock seconds]
+
+ global bufdata
+ if {![regexp {^(.*?)[\r\n]+(.*)$} $got dummy lhs rhs]} {
+ append bufdata $got
+ return
+ }
+
+ set l "$bufdata$lhs"
+ set bufdata $rhs
+puts ">>$l<<"
+ uplevel 1 $body
+ }
+}
+
+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 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 {
+ process-line $l
+ }
+
+ with-file {
+
+ }
+
+ while 1 {
+ set data read
}
}
-proc refresh {} {
+proc parseargs {} {
+ global argv
+ foreach arg $argv {
+ if {![string compare $arg --test-tints]} {
+ showtints
+ } else {
+ error "unknown option $arg"
+ }
+ }
}
-init
+menus
+nonportability
+parseargs
+widgets
+clearlists
if {[file exists $defaultfile]} {
source $defaultfile
}
-refresh
+pollfile
~yarrgweb / ypp-sc-tools.db-live.git / blobdiff