# Description: displays a bar graph of lag in the status window procs event_PONG proc event_PONG {header line} { if [string match lag_* $line] { set line [split $line _] set timer [lindex $line 1] set line [lindex $line 2] catch "after cancel $timer" set num [expr round(([clock clicks -milliseconds] - $line) / 1000.00)] [namespace qualifiers [namespace origin event_PONG]]::updatelag $num } } proc createlagmeter {} { if {[winfo exists .0.menubar.lag]} {return} frame .0.menubar.lag -relief sunken -bd 1 pack [frame .0.menubar.lag.0 -bg #009900 -width 5] -side left -padx 1 -pady 2 -fill y foreach x "1 2 3 4 5" { pack [frame .0.menubar.lag.$x -width 20] -side left -fill y -padx 1 -pady 2 } pack .0.menubar.lag -side right -fill y -pady 2 -ipady 2 -ipadx 1 } proc lagtimer {} { global ume irc server if [info exists irc] { Send "PING lag_[after 5200 [list [namespace current]::updatelag 7]]_[clock clicks -milliseconds] :$server" } after 8000 [list [namespace current]::lagtimer] } proc updatelag {num} { array set color "1 #009900 2 #009900 3 #AAAA00 4 #990000 5 #990000" set bg [.0.menubar.lag cget -bg] foreach x "1 2 3 4 5" { if {$num >= $x} { .0.menubar.lag.$x configure -bg $color($x) } else { .0.menubar.lag.$x configure -bg $bg } } } proc unload {} { foreach x [after info] { if {[string match "[namespace current]::*" [lindex [lindex [after info $x] 0] 0]} {after cancel $x} } destroy .0.menubar.lag } after idle [namespace current]::createlagmeter foreach x [after info] { if {[lindex [lindex [after info $x] 0] 0] == "[namespace current]::lagtimer"} {after cancel $x} } lagtimer