Updated 2013-12-27 07:07:13 by RLE

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```