Version 2 of blinking non-painful

Updated 2019-02-20 08:07:30 by wdb

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 .] <Destroy> 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
}