blink

blink widget args

provides smooth blinking to any item without hurting the eyes

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 in "stop off"} then {
    #
    # stop all after-events
    #
    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 class [winfo class $widget]
      #
      # prepare
      #
      set item {
        -step 0
        -red0 0
        -green0 0
        -blue0 0
        -tag blink
        -red1 65535
        -green1 65535
        -blue1 65535
        -interval 25
        -action continue
      }
      #
      # set default target attributes
      #
      switch -exact -- $class {
        Text {
          dict set item -att -foreground
        }
        Canvas {
          dict set item -att -fill
        }
        default {
          dict set item -att -fg
        }
      }
      #
      # customize by command line
      #
      dict for {key val} $args {
        dict set item $key $val
      }
      #
      # translate named colors if given
      #
      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 {
        #
        # calculate increasement of color
        #
        dict incr item -step
        if {[dict get $item -step] >= 100} then {
          dict set item -step 0
        }
        set pi [expr {
          atan2(0,-1)
        }]
        set factor [expr {
          (cos($pi * 2 * [dict get $item -step] / 100) + 1) / 2
        }]
        #
        # generate hexadecimal color string
        #
        set rrrrggggbbbb #
        #
        set red0 [dict get $item -red0]
        set red1 [dict get $item -red1]
        set red [expr {$red0+int(($red1-$red0)*$factor)}]
        append rrrrggggbbbb [format %04x $red]
        #
        set green0 [dict get $item -green0]
        set green1 [dict get $item -green1]
        set green [expr {$green0+int(($green1-$green0)*$factor)}]
        append rrrrggggbbbb [format %04x $green]
        #
        set blue0 [dict get $item -blue0]
        set blue1 [dict get $item -blue1]
        set blue [expr {$blue0+int(($blue1-$blue0)*$factor)}]
        append rrrrggggbbbb [format %04x $blue]
        #
        set tag [dict get $item -tag]
        set att [dict get $item -att]
        switch -exact -- $class {
          Canvas {
            $widget itemconfigure $tag $att $rrrrggggbbbb
          }
          Text {
            $widget tag configure $tag $att $rrrrggggbbbb
          }
          default {
            $widget configure $att $rrrrggggbbbb
          }
        }
        #
        # repeat
        #
        set interval [dict get $item -interval]
        after $interval [list blink $widget {*}$item]
        #
      } else {
        #
        # stop blinking of $widget
        #
        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
          }
        }
      }
    }
  }
}

© Wolf-Dieter Busch | Home | Sitemap | Urheber | A-Z