ypp-chatlog-alerter: wip

diff --git a/ypp-chatlog-alerter b/ypp-chatlog-alerter
index 396d69e4c9f2fd8627aea2ca4a82a6794610bd07..9db7bc61e7b3763050a653eb79a0ce5281a3bc58 100755 (executable)
--- a/ypp-chatlog-alerter
+++ b/ypp-chatlog-alerter
@@ -88,17 +88,28 @@ set tint_switch 90
 set tint_switched [expr { exp( -($tint_switch+0.0) / $e_life ) }]
 
 proc retint {} {
 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 i 0
     set now [clock seconds]

+    set latest $otherevent

     foreach time $times {
     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 *
     global tint_switched
     #puts "$tint $tint_switched"
     set yellow [format "%02x" [expr {round( 255 *


@@ -107,20 +118,25 @@ proc tintentry {w y tint} {
     set black [format "%02x" [expr {round( 255 *
        ( $tint >= $tint_switched ? 0 : ($tint / $tint_switched)*0.75 + 0.25 )
                                           )}]]
     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 {} {
 }
 
 proc clearlists {} {

-    global height
+    global height otherevent

     global times pirates messages
     set currentfile {}
     
     for_lw { .$w delete 0 end; set $l {} }
     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 {} }
     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 {} {
 }
 
 proc showtints {} {


@@ -129,16 +145,15 @@ 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}]
     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"
        .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
 }
     }
     pack .tints -side bottom
 }

-           
+

 proc parseargs {} {
     global argv
     foreach arg $argv {
 proc parseargs {} {
     global argv
     foreach arg $argv {