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
Addendum: extended to text tags; more sub-functions.
if false {
Make widgets or canvas items non-painfully blink.
Examples:
blink .label
blink .canvas -tag ball
blink .text -color0 blue -color1 yellow
blind .text -color0 yellow -color1 blue -att background
blink info
blink .canvas stop
blink stop
With Text widget, default attribute is -foreground
with Canvas widget, default attribute is -fill
With Text and Canvas widgets, default tag is "blink".
}
proc blink {widget args} {
lassign [info level 0] blink
if {$widget eq "info"} then {
# info
set result {}
foreach event [after info] {
set info [after info $event]
if {[lindex $info end] eq "timer" &&
[lindex $info 0 0] eq $blink} then {
lassign $info cmd
lassign $cmd blink widget
if {[winfo exists $widget]} then {
set line [list $blink $widget]
set opts [lrange $cmd 2 end]
if {[winfo class $widget] in {Text Canvas}} then {
lappend line -tag [dict get $opts -tag]
}
lappend line -att [dict get $opts -att]
lappend result $line
}
}
}
lsort $result
} elseif {$widget eq "stop"} then {
# stop
foreach event [after info] {
set info [after info $event]
if {[lindex $info end] eq "timer" &&
[lindex $info 0 0] eq $blink} then {
after cancel $event
}
}
} elseif {[winfo exists $widget]} then {
if {$args eq "stop"} then {
$blink $widget -action stop
} else {
set pi [expr {atan2(0,-1)}]
set item {-att -fg
-step 0
-red0 0
-green0 0
-blue0 0
-tag blink
-red1 65535
-green1 65535
-blue1 65535
-interval 25
-action continue}
if {[winfo class $widget] eq "Text"} then {
dict set item -att -foreground
} elseif {[winfo class $widget] eq "Canvas"} then {
dict set item -att -fill
}
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 -tag]\
[dict get $item -att] #$r$g$b
} elseif {[winfo class $widget] eq "Text"} then {
$widget tag configure\
[dict get $item -tag]\
[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 .] <Destroy> exit
pack\
[label .l -text Howdy! -font {Times 96}]\
[canvas .c -height 120]\
[text .t -height 5 -width 40 -font "Helvetica 15"]
.c create oval 10 10 110 110 -fill white -width 5 -tags ball
.t insert 1.0 {Ein } {} blinkender blink { Text}
blink .l
blink .c -tag ball -color0 green -color1 red
blink .t -color0 blue -color1 red
blink .t -color1 blue -color0 yellow -att -background
}