if 0 {Richard Suchenwirth 2004-08-18 - Here's another simple canvas animation, with a kind of hypnotic effect: growing ovals in rainbow colors create the impression of moving through a psychedelic tunnel. Ten times a second, a tiny circle is created in the center, then all circles zoomed by 20%, and finally those circles removed which are "out of sight" (if not doing so, the program will soon crash).
}
set colors {purple blue green3 green yellow orange red magenta} proc rainbowtunnel w { $w create oval 99 99 101 101 -fill [lcycle ::colors] \ -outline {} -tag oval $w scale oval 100 100 1.2 1.2 foreach item [$w find withtag oval] { if {[lindex [$w bbox $item] 0]<-50} {$w delete $item} } }
#-- General-use utilities:
proc lcycle listVar { upvar 1 $listVar list set first [lindex $list 0] set list [linsert [lrange $list 1 end] end $first] set first } proc every {ms body} {eval $body; after $ms [info level 0]}
#-- "main"
pack [canvas .c -width 200 -height 200] every 100 {rainbowtunnel .c}
if 0 {
See also TclTrain where the same effect is used on a railroad.
Category Animation | Arts and crafts of Tcl-Tk programming }