[US] I made this Christmas fun program to show my son and his class mates how easy programming in Tcl is compared to Java (They had to write a similar program in their Java course at school).

Usage:
   * 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

Have fun.
Merry Christmas.
----
[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
----
[Category Toys] - [Category Graphics]