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

See also TclTrain where the same effect is used on a railroad.

Category Animation

Arts and crafts of Tcl-Tk programming