set tint_switched [expr { exp( -($tint_switch+0.0) / $e_life ) }]
proc retint {} {
- global times e_life
+ global times e_life retint_after otherevent
+ catch { after cancel $retint_after }
set i 0
set now [clock seconds]
+ set latest $otherevent
foreach time $times {
- set agescale [expr {
- exp( -($now >= $time ? $now-$time : 0) / $e_life )
- }]
+ set latest [expr { $time > $latest ? $time : $latest }]
+ set tint [expr {
+ exp( -($now >= $time ? $now-$time : 0) / $e_life )
+ }]
+ tintentries .t $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 tintentry {w y tint} {
+proc tintentries {ws y tint} {
global tint_switched
#puts "$tint $tint_switched"
set yellow [format "%02x" [expr {round( 255 *
set black [format "%02x" [expr {round( 255 *
( $tint >= $tint_switched ? 0 : ($tint / $tint_switched)*0.75 + 0.25 )
)}]]
- $w itemconfigure $y \
- -foreground [format "#${black}${black}${black}"] \
- -background [format "#${yellow}${yellow}00"]
+ 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
+ global height otherevent
global times pirates messages
set currentfile {}
for_lw { .$w delete 0 end; set $l {} }
+ set ntimes {}
for {set i 0} {$i<$height} {incr i} {
for_lw { lappend $l {}; .$w insert end {} }
+ lappend ntimes 0
}
+ set times $ntimes
+ set otherevent [clock seconds]
+ retint
}
proc showtints {} {
listbox .tints -width 60 -height [expr {$divs+1}]
for {set y 0} {$y <= $divs} {incr y} {
set tint [expr {($y+0.0)/$divs}]
- puts "$y $tint"
.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"
- tintentry .tints $y $tint
+ tintentries .tints $y $tint
}
pack .tints -side bottom
}
-
+
proc parseargs {} {
global argv
foreach arg $argv {