Version 4 of blinking non-painful

Updated 2019-03-19 10:38:51 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

Addendum: exteded 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
}