Move the extension-less sample scripts in a filenames/ subdir

This commit is contained in:
quentin
2014-10-13 10:09:07 +02:00
parent baa3cba0fc
commit 48f2949d69
2 changed files with 0 additions and 0 deletions

28
samples/Tcl/filenames/starfield Executable file
View File

@@ -0,0 +1,28 @@
#!/usr/bin/env wish
# http://wiki.tcl.tk/14140
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)
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