mirror of
https://github.com/KevinMidboe/linguist.git
synced 2025-10-29 17:50:22 +00:00
Move the extension-less sample scripts in a filenames/ subdir
This commit is contained in:
28
samples/Tcl/filenames/starfield
Executable file
28
samples/Tcl/filenames/starfield
Executable 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
|
||||
Reference in New Issue
Block a user