[wdb] Blinking elements make headache. Here is a smooth blink. The secret: change color continuously, and not linear but with sinus transformation. License as always [OLL] ====== if false { Make widgets or canvas items non-painfully blink. Example: blink .label -color0 black -color1 yellow blink .canvas -item ball -att -fill blink .canvas stop } proc blink {widget args} { lassign [info level 0] blink if {$args eq "stop"} then { tailcall $blink $widget -action stop } set pi [expr {atan2(0,-1)}] set item {-att -fg -step 0 -red0 0 -green0 0 -blue0 0 -item none -red1 65535 -green1 65535 -blue1 65535 -interval 25 -action continue} dict for {key val} $args { dict set item $key $val } # if {[dict exists $item -color0]} then { lassign [winfo rgb . [dict get $item -color0]] r g b dict set item -red0 $r dict set item -green0 $g dict set item -blue0 $b dict unset item -color0 } if {[dict exists $item -color1]} then { lassign [winfo rgb . [dict get $item -color1]] r g b dict set item -red1 $r dict set item -green1 $g dict set item -blue1 $b dict unset item -color1 } # if {[dict get $item -action] eq "continue"} then { dict incr item -step if {[dict get $item -step] >= 100} then { dict set item -step 0 } set factor [expr { (cos($pi*2*[dict get $item -step]/100)+1)/2 }] set red0 [dict get $item -red0] set red1 [dict get $item -red1] set red [expr {$red0+int(($red1-$red0)*$factor)}] set green0 [dict get $item -green0] set green1 [dict get $item -green1] set green [expr {$green0+int(($green1-$green0)*$factor)}] set blue0 [dict get $item -blue0] set blue1 [dict get $item -blue1] set blue [expr {$blue0+int(($blue1-$blue0)*$factor)}] set r [format %04x $red] set g [format %04x $green] set b [format %04x $blue] if {[winfo class $widget] eq "Canvas"} then { $widget itemconfigure\ [dict get $item -item]\ [dict get $item -att] #$r$g$b } else { $widget configure [dict get $item -att] #$r$g$b } after [dict get $item -interval]\ [list $blink $widget {*}$item] } else { # stop foreach event [after info] { set info [after info $event] set line [lindex $info 0] lassign $line proc arg if {$proc eq $blink && $arg eq $widget} then { after cancel $event } } } } if true { package require Tk bind [winfo class .] exit pack\ [label .l -text Howdy! -font {Times 96}]\ [canvas .c] .c create oval 10 10 110 110 -fill white -width 5 -tags ball blink .l blink .c -item ball -att -fill -color0 red -color1 blue } ======