- double click left button to create a star.
- drag stars around with left button pressed
- change color of a star by clicking right button
- delete a star by double clicking right button
GPS: I like it. It makes some beautiful patterns. Thanks for sharing :)
#! /usr/local/bin/wish8.4
package require Tk
# generate a random integer between from (inclusive) and to (exclusive)
proc random {from to} {
return [expr {int(($to - $from)*rand()+$from)}]
}
# create a star
# at position $pos
# with inner size [lindex $size 0]
# and outer size [lindex $size 1]
# rotated by $rot degrees
# with $n sparkles
proc star {{pos {200 200}} {size {40 100}} {rot -18} {n 5}} {
set rot [expr {3.14159 * $rot / 180.0}]
set inc [expr {6.28318 / $n}]
foreach {xpos ypos} $pos break
foreach {mind maxd} $size break
for {set i 0} {$i < $n} {incr i} {
lappend star [expr {cos($inc * $i + $rot) * $maxd / 2.0 + $xpos}]
lappend star [expr {sin($inc * $i + $rot) * $maxd / 2.0 + $ypos}]
lappend star [expr {cos($inc * ($i + 0.5) + $rot) * $mind / 2.0 + $xpos}]
lappend star [expr {sin($inc * ($i + 0.5) + $rot) * $mind / 2.0 + $ypos}]
}
return $star
}
# start moving a star
proc start_move {x y} {
global x0 y0
set x0 $x
set y0 $y
}
# move a star
proc move {canv id x y} {
global x0 y0
$canv move $id [expr {$x - $x0}] [expr {$y - $y0}]
set x0 $x
set y0 $y
}
# draw a star (generated by star) on canvas $canv with color $col
proc draw_star {canv star {col yellow}} {
set star_id [$canv create polygon $star -outline black -width 1 -fill $col -tags star]
# bindings for star movement
$canv bind $star_id <1> {start_move %x %y}
$canv bind $star_id <B1-Motion> "move $canv $star_id %x %y"
# binding for color change
$canv bind $star_id <3> "$canv itemconfigure $star_id -fill \[new_color]"
# binding for star removal
$canv bind $star_id <Double-3> "$canv delete $star_id"
}
# create a new star with random attributes
proc new_star {canv {pos {}}} {
if {[llength $pos] != 2} {
set pos [list [random 80 720] [random 80 520]]
}
set size [list [random 10 50] [random 60 200]]
set rot [random 0 360]
set n [random 3 10]
set col [new_color]
draw_star $canv [star $pos $size $rot $n] $col
}
# generate a color
proc new_color {} {
format "#%02x%02x%02x" [random 0 255] [random 0 255] [random 0 255]
}
wm title . "XmasStar - use the mouse, Luke"
canvas .c -background #000040 -width 800 -height 600
bind .c <Double-1> {new_star .c {%x %y}}
pack .c
