Version 8 of A minimal starfield

if 0 {Richard Suchenwirth 2005-05-17 - In a few leisurely minutes at work, I hacked together these few LOC that give you kind of a starfield animation by scaling ovals on a canvas :) Featuritis demanded different colors, and user-controllable speed (<Up> and <Down> cursor keys), but it's still pretty small.

}

 package require Tk
 proc stars'go {c factor} {
     set w [winfo width $c]
     set h [winfo height $c] 
     $c scale all [expr {$w/2.}] [expr {$h/2.}] $factor $factor 
     foreach item [$c find all] {
         foreach {x0 y0 x1 y1} [$c bbox $item] break
         if {$x1<0 || $x0>$w || $y1<0 || $y0>$h} {$c delete $item}
     }
     time {
         set x [expr {rand()*$w}]
         set y [expr {rand()*$h}]
         set col [lpick {white yellow beige bisque cyan}]
         $c create oval $x $y [expr {$x+1}] [expr {$y+1}] -fill $col \
                 -outline $col
     } 10
     after $::ms [info level 0]
 }
 proc lpick list {lindex $list [expr {int(rand()*[llength $list])}]}

#-- Let's go!

 pack [canvas .c -bg black] -fill both -expand 1
 set ms 40
 bind . <Up> {incr ms -5}
 bind . <Down> {incr ms 5}
 stars'go .c 1.05

if 0 {

Neat, but I flew through a star and it crashed. Will have to add code to protect against the ovals from getting too large. Earl Johnson

Category Animation - Arts and crafts of Tcl-Tk programming}