[Keith Vetter] 2005-12-13 : Here's a cute little animation that I 
recently rediscovered on my hard drive.

======
 ##+##########################################################################
 #
 # Animated Circles.tcl
 # by Keith Vetter
 #

 package require Tk
 
 array set S {step 1 delay 25 stop 0}
 proc Expand {xy d} {
    foreach {x0 y0 x1 y1} $xy break
    list [expr {$x0-$d}] [expr {$y0-$d}] [expr {$x1+$d}] [expr {$y1+$d}]
 }
 proc Recenter {W h w} {
    set h [expr {$h / 2.0}] ; set w [expr {$w / 2.0}]
    $W config -scrollregion [list -$w -$h $w $h]
 }
 
 proc Step {} {
    foreach tag [.c find withtag o] {
        set xy [Expand [.c coords $tag] $::S(step)]
        .c coords $tag $xy
    }
    if {[lindex [.c coords o$::S(smallest)] 2] < 10} return
    set biggest [expr {($::S(smallest) - 1) % $::S(cnt)}]
    .c coords o$biggest {0 0 0 0}
    set ::S(smallest) $biggest
 }
 proc Animate {} {
    if {$::S(stop)} return
    Step
    after $::S(delay) Animate
 }
 
 wm title . "Animated Circles"
 canvas .c -bg blue -width 400 -height 200 -highlightthickness 0
 pack .c -fill both -expand 1
 bind .c <Configure> {Recenter %W %h %w}
 bind all <Key-F2> {console show}
 
 set r [expr {int(1+hypot([winfo screenwidth .]/2,[winfo screenheight .]/2)/10)}]
 set xy [list 0 0 0 0]
 for {set i 0} {$i <= $r} {incr i} {
    .c create oval $xy -outline green -width 5 -tag [list o o$i]
    set xy [Expand $xy 10]
 }
 set S(smallest) 0
 set S(cnt) [llength [.c find withtag o]]
 
 .c create text 0 0 -anchor c -fill red -font {Helvetica 36 bold} -text "Welcome to\nTcl/tk" -justify center
 Animate    
 return
======

[AMG]: AAUGH IT'S DOING THINGS TO MY MIND!!

Heh, it would be double awesome if you could have a second set of concentric circles, contracting instead of expanding, clipped to the text.

[DKF]: The [canvas] doesn't support arbitrary clipping, so that's tricky. Indeed, it doesn't support clipping at all; you'd have to add that using an extension (such as my [shape] extension, which does (widget) clipping by text among other things, and which IIRC comes with a demo showing how to do such clipping).

----

[uniquename] 2013jul29

This code could use an image to show what it produces:

[vetter_animatedCircles_wiki15104_screenshot_404x225.jpg]

(Thanks to 'gnome-screenshot', 'mtpaint', and ImageMagick 'convert' on Linux for,
respectively, capturing the image to a PNG file, cropping the image, and converting
the resulting PNG file to a somewhat smaller JPEG file. Thank you FOSS developers everywhere.)

This static image does not do justice to the effect. Stare at the expanding circles
for a few seconds and you may become hypnotized and glued to your monitor.

----
'''Gerhard Reithofer 2017-05-11'''

I was asked if it is possible to create an "animated widget" in TCL like it is used in modern GUIs. 
I tried to create a typical radio-like symbol as it is used often for WLANs.

The result is:
======

package require Tk 8.5

namespace eval DynWidget {
    variable widget         ; # canvas to draw on
    variable lwidth 5       ; # drawing line width
    variable dcolor "grey"  ; # drawing color
    variable bckgnd "white" ; # background color
    variable jstyle "round" ; # line join style
    variable rad ; # radius variation values
    variable col ; # color variation values
    variable t_font {Helvetica 14 bold}
    variable version "0.2"
    
    # wave radius values
    set rad {10 20 30 40 50}
    # circle fading colors (delta rad entries)
    set col {
        #707070 #808080 #909090 #a0a0a0 #b0b0b0
        #c0c0c0 #d0d0d0 #e0e0e0 #f0f0f0 #ffffff
    }
    
    # coord components and simple item identifying method
    proc CX {vec} {return [lindex $vec 0]}
    proc CY {vec} {return [lindex $vec 1]}
    proc ID {typ name} {return "${typ}_${name}"}
    
    # create canvas to draw on
    proc painton {w size} {
        variable widget
        variable bckgnd
        # create canvas to paint on
        set opts [list -width [CX $size] -height [CY $size] -bg $bckgnd]
        pack [set widget [canvas $w.c {*}$opts]]
        # returning center of the canvas
        return [lmap p {width height} {expr [$widget cget -$p]/2}]
    }
    
    # create or set item properties for $cid
    proc dataof {cid typ coords args} {
        variable widget
        # search or create object
        set item [$widget find withtag $cid]
        if {$item eq ""} {
            set item [$widget create $typ $coords -tags $cid]
        } else {
            $widget coords $item $coords
        }
        # apply the changing options ...
        $widget itemconfigure $item {*}$args
        return $item
    }
    
    # draw or modify circle $cid
    proc circle {cid x y r col} {
        variable lwidth
        set opts [list -width $lwidth -outline $col]
        set coords [list [expr {$x-$r}] [expr {$y-$r}]\
                [expr {$x+$r}] [expr {$y+$r}]]
        return [dataof [ID "wave" $cid] oval $coords {*}$opts]
    }
    
    # draw or modify triangle $cid
    proc tower {cid top hgt wh} {
        variable bckgnd
        variable dcolor
        variable lwidth
        variable jstyle
        set opts [list -fill $bckgnd -width $lwidth\
                -outline $dcolor -joinstyle $jstyle]
        lappend top [expr {[CX $top] - $wh}] $hgt
        lappend top [expr {[CX $top] + $wh}] $hgt
        return [dataof [ID "tower" $cid] polygon $top {*}$opts]
    }
    
    # draw or modify text $cid
    proc gtext {cid coords txt} {
        variable t_font
        set opts [list -font $t_font -text $txt -justify center]
        return [dataof [ID "text" $cid] text $coords {*}$opts]
    }
    
    # draw or modify circles (i. e. animation)
    proc wave {cx cy wait} {
        variable widget
        variable rad
        variable col
        set rmax [expr {[llength $rad]-1}]
        set cmax [expr {[llength $col]-1}]
        for {set ci 0} {$ci <= $cmax} {incr ci} {
            set co [expr {$cmax - $ci}]
            for {set ri 0} {$ri <= $rmax} {incr ri} {
                set r [expr {[lindex $rad $ri] + $ci}]
                switch $ri 0 {set ca [lindex $col $co] ; # fade in
                } $rmax {set ca [lindex $col $ci] ; # fade out
                } default {set ca [lindex $col 0]}
                # draw/modify circle with new radius $r and color $ca
                set item [circle $ri $cx $cy $r $ca]
                $widget lower $item
                update
            }
            after $wait
        }
    }
    
    # initialize basic graphics
    proc setup {w c_size t_size} {
        set cp [painton $w $c_size]
        tower "tower" $cp [CX $t_size] [CY $t_size]
        return $cp
    }
}

set cnv_size {320 240}
set tower_sz {230 30}
set tx_title "Press Esc to exit ..."
set waitmsec 100

wm title . "DynWidget $DynWidget::version"
bind . <Escape> {exit 0}

set cp [DynWidget::setup "" $cnv_size $tower_sz]
if {$tx_title ne ""} {
    DynWidget::gtext "title" [list [DynWidget::CX $cp] 20] $tx_title
}
while {true} {
    DynWidget::wave [DynWidget::CX $cp] [DynWidget::CY $cp] $waitmsec
}
======

Screenshot of the dynamic changing widget, the circles fade in at first and increase their radius until they fade out.   

[Dynamic Widget]


<<categories>> Animation