[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.

----

[Category Animation]