A minimal starfield

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.

WikiDbImage stars.jpg

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] {
        if {[llength [$c bbox $item]] == 0} {$c delete $item; continue} ;# (1)
        lassign [$c bbox $item] x0 y0 x1 y1
        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

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 - RS: How did it crash? If a star starts exactly from the centre, it will grow very big - but be deleted when it exceeds one of the canvas boundaries.

After more testing I have not been able to reproduce the problem. I guess that what I saw was what MAK saw but it just happen to happen while I was flying through a sun. Earl Johnson

MAK

can't read "x1": no such variable
can't read "x1": no such variable
   while executing
"if {$x1<0 || $x0>$w || $y1<0 || $y0>$h} {$c delete $item}"
   (procedure "stars'go" line 7)
   invoked from within
"stars'go .c 1.05"
   ("after" script)

APE: following comment applied to use of foreach ... break trick to set a list, replaced by lassign command

RS: Interesting - that means there was a canvas item with an empty bounding box, so the

foreach {x0 y0 x1 y1} [$c bbox $item] break

command didn't set any of these four variables. This is documented in the canvas man page: "If no items match any of the tagOrId arguments or if the matching items have empty bounding boxes (i.e. they have nothing to display) then an empty string is returned." Thanks for the hint (though I still don't understand why an oval should have nothing to display...) Added a safety belt, see #(1) above.

MG thinks there's a mistake in your change - should that $c delete item be $c delete $item? RS: Oops - fixed.. as I couldn't reproduce the problem, this line was never tested...

Replace the scale with this for a neat effect:

set x [$c canvasx [expr {[winfo pointerx $c] - [winfo rootx $c]}]]
set y [$c canvasy [expr {[winfo pointery $c] - [winfo rooty $c]}]]
$c scale all $x $y $factor $factor

AMG: That's a bizarre use of [time], but it's still easier to read than [for]. :^)

HE: To my surprise. [time] uses less chars but is a litte bit slower than [for].

(bin) 17 % time {time {set a b} 10} 100000
14 microseconds per iteration
(bin) 18 % time {for {set n 0} {$n < 10} {incr n} {set a b}} 100000
11 microseconds per iteration

RS: This may have to do with the fact that the body of a for loop is compiled, while for time it isn't. The usual recommendation is to put the tode to test in a proc, which is always compiled, and here the difference is smaller, and a bit in favour of time:

% proc test args {string toupper $args}
% time {time {test this example} 10} 10000
53 microseconds per iteration
% time {for {set i 0} {$i<10} {incr i} {test that example}} 10000
55 microseconds per iteration
% time {time {test this example} 10} 10000
54 microseconds per iteration
% time {for {set i 0} {$i<10} {incr i} {test that example}} 10000
56 microseconds per iteration

HE I agree to put the code to test in a [proc]. But didn't we try to compare

time {set a b} 10

with

for {set n 0} {$n < 10} {incr n} {set a b}

Or based on your example

time {test this example} 10

with

for {set i 0} {$i<10} {incr i} {test that example}

My results:

% proc test1 {} {time {set a b} 10}
% time {test1} 10000
13 microseconds per iteration
% proc test2 {} {for {set i 0} {$i<10} {incr i} {set a b}}
% time {test2} 10000
3 microseconds per iteration

Or based on your example:

% proc test args {string toupper $args}
% proc test1 {} {time {test this example} 10}
% time {test1} 10000
38 microseconds per iteration
% proc test2 {} {for {set i 0} {$i<10} {incr i} {test that example}}
% time {test2} 10000
31 microseconds per iteration

Converting this code to tkpath gets an error on $c delete $item; I found a patch for tkpath on github that covers this issue, but it isn't available yet from teacup?

Category Animation

Arts and Crafts of Tcl-Tk Programming