Rainbow Tunnel
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). For a more "moving" effect, rmax proposed to zoom by 10%, but paint each two consecutive circles in the same color (that's why I added the duplicating list colors2).
package require Tk
proc rainbowtunnel w {
$w create oval 99 99 101 101 -fill [lcycle ::colors2] \
-outline {} -tag oval
$w scale oval 100 100 1.1 1.1
foreach item [$w find withtag oval] {
if {[lindex [$w bbox $item] 0]<-50} {$w delete $item}
}
after 100 [list after idle [info level 0]]
}
#-- 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
}
set colors {purple blue green3 green yellow orange red magenta}
foreach color $colors {lappend colors2 $color $color}
#-- "main"
pack [canvas .c -width 200 -height 200]
rainbowtunnel .cSee also TclTrain where the same effect is used on a railroad.