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