- 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