HJG Inspired by Xmas Tree from RS, here is a version where you can decorate the tree yourself.
The candles are animated with a bit of flickering.
Merry Christmas !
#!/bin/sh
# Restart with tcl: -*- mode: tcl; tab-width: 4; -*- \
exec wish $0 ${1+"$@"}
# XmasTree2.tcl - HaJo Gurt - 2005-12-23 - http://wiki.tcl.tk/15176
#: Design your own Christmas Tree
# See also: Xmas Tree by R. Suchenwirth 2005-12-22, http://wiki.tcl.tk/15164
#
# Click to place new decorations
# Right-click to remove
# F1 to show console
# Cut+paste your design from console-log to proc Decorate
#
# 2005-12-23 First Version
# 2005-12-24 added: small bell, small candle
# Todo:
# Save to image/jpg, load/save layout (serialize to file), move items,
# more generic / resizable tree,
# more decoration-items (lametta, garlands ...)
#########1#########2#########3#########4#########5#########6#########7#####
package require Tk
proc every {ms body} {eval $body; after $ms [info level 0]}
proc lpick list {lindex $list [expr {int(rand()*[llength $list])}]}
proc Color {nr} {
set c [lindex {red orange yellow green cyan blue magenta pink grey20 } $nr]
}
#########1#########2#########3#########4#########5#########6#########7#####
proc DeleteItem {} {
#: Find all parts of an item and delete them, e.g. candle+flame
set Tags [.c itemcget current -tag ]
foreach Nr [split $Tags] {
if { [string index $Nr 0] == "i"} { .c delete $Nr }
}
}
proc NewItem { i x y c } {
#: Schedule new item to put on tree
set ItemType [string map {Candle C Star s Bauble b Bell B } $i ]
if { $i=="random" } {
set ItemType [lpick {C1 C2 B4 B6 b4 b6 b8 s4 s5 s6 s8} ]
}
if { $c=="random" } {
set c [lpick {red orange gold yellow green cyan blue magenta white gray} ]
}
incr ::nItem 1
switch -- $ItemType {
C1 { NewCandle $x $y $c 1 }
C2 { NewCandle $x $y $c 2 }
B4 { NewBell $x $y $c 4 }
B6 { NewBell $x $y $c 6 }
s4 { NewStar $x $y $c 4 }
s5 { NewStar $x $y $c 5 -18 }
s6 { NewStar $x $y $c 6 }
s8 { NewStar $x $y $c 8 }
b8 { NewBauble $x $y $c 8 }
b6 { NewBauble $x $y $c 6 }
default { NewBauble $x $y $c 4 }
}
}
#########1#########2#########3#########4#########5#########6#########7#####
proc NewCandle {x1 y1 {c red} {s 2} } {
#: Create new decoration: Candle with flame
.c create rect $x1 $y1 \
[expr $x1+4] [expr $y1-$s*10 ] -fill $c -tags "candle i$::nItem"
.c create oval [expr $x1-1] [expr $y1-$s*10- 1] \
[expr $x1+5] [expr $y1-$s*10-11] -fill yellow -tags "flame i$::nItem"
puts " C$s $x1 $y1 $c"
}
proc NewBell {x1 y1 {c gold} {size 4} } {
#: Create new decoration: Bell
if {$size==6} {
.c create oval [expr $x1- 6] [expr $y1+0] \
[expr $x1+ 6] [expr $y1+22] -fill $c -tags "bell i$::nItem"
.c create poly $x1 [expr $y1+10] \
[expr $x1-12] [expr $y1+20] \
[expr $x1+12] [expr $y1+20] -fill $c -tags "bell i$::nItem"
} else {
.c create oval [expr $x1- 4] [expr $y1+ 0] \
[expr $x1+ 4] [expr $y1+15] -fill $c -tags "bell i$::nItem"
.c create poly $x1 [expr $y1+ 5] \
[expr $x1- 8] [expr $y1+14] \
[expr $x1+ 8] [expr $y1+14] -fill $c -tags "bell i$::nItem"
}
puts " B$size $x1 $y1 $c"
}
proc Star { {x 100} {y 20} {n 5} {rot 0} {size {8 24}} } {
#: Create polygon for a star
# at position $x $y
# with $n rays
# with inner size [lindex $size 0]
# and outer size [lindex $size 1]
# rotated by $rot degrees
set rot [expr {3.14159 * $rot / 180.0}]
set inc [expr {6.28318 / $n}]
foreach {mind maxd} $size break
for {set i 0} {$i < $n} {incr i} {
lappend star [expr {cos($inc * $i + $rot) * $maxd / 2.0 + $x}]
lappend star [expr {sin($inc * $i + $rot) * $maxd / 2.0 + $y}]
lappend star [expr {cos($inc * ($i + 0.5) + $rot) * $mind / 2.0 + $x}]
lappend star [expr {sin($inc * ($i + 0.5) + $rot) * $mind / 2.0 + $y}]
}
return $star
}
proc NewStar {x y {c gold} {n 4} {rot 0} } {
#: Create new decoration: Star
set star [Star $x $y $n $rot]
.c create polygon $star -outline black -width 1 -fill $c -tags "star i$::nItem"
puts " s$n $x $y $c"
}
proc NewBauble {x y {c grey} {s 4} } {
#: Create new decoration: Bauble = Sphere, glass ball
.c create oval [expr $x-$s] [expr $y-$s] [expr $x+$s] [expr $y+$s] \
-fill $c -tag "bauble i$::nItem"
puts " b$s $x $y $c"
}
#########1#########2#########3#########4#########5#########6#########7#####
proc Flicker {id} {
#: Fast color-cycling to flicker a candle-flame
set Color [lpick {yellow "light yellow" orange gold goldenrod red red2 linen white}]
.c itemconfig $id -fill $Color
if {$Color != "yellow" } {after 20 Flicker $id}
}
proc Animate {} {
#: Select a candle and make it flicker
set Selection [.c find withtag flame]
if { $Selection != "" } { Flicker [lpick $Selection] }
}
#########1#########2#########3#########4#########5#########6#########7#####
proc MakeTree { {xm 200} {ym 300} } {
#: Build a simple christmas-tree
.c create poly 70 290 130 290 100 270 -fill black
.c create rect 95 250 105 275 -fill brown
foreach dx {40 55 70 85 100} y {20 60 100 140 180} {
.c create poly 100 $y \
[expr 100-$dx] [expr $y+70] \
[expr 100+$dx] [expr $y+70] -fill darkgreen -tag tree
}
}
proc Decorate {} {
#: Put some decorations on the tree
#!! Cut+paste your design here from the console-output !!
foreach {i x y c} { s8 100 20 gold C1 16 241 red C2 55 123 red
C2 155 166 red
B4 42 165 magenta
B6 143 244 gold
b4 75 142 cyan
b6 54 244 green
b8 166 213 gray
s4 85 203 blue
s5 110 76 white
s6 116 158 yellow
} { NewItem $i $x $y $c }
}
#########1#########2#########3#########4#########5#########6#########7#####
pack [canvas .c -width 200 -height 300 -background darkblue]
frame .f1
pack .f1
tk_optionMenu .m1 Color red orange gold yellow green green4 cyan blue magenta white gray random
tk_optionMenu .m2 ItemType Candle1 Candle2 Bell4 Bell6 Bauble4 Bauble6 Bauble8 Star4 Star5 Star6 Star8 random
pack .m1 .m2 -in .f1 -side left
set nItem 0
MakeTree
Decorate
wm title . "Merry Christmas !"
set ItemType "random"
set ItemType "Candle2"
set Color "random"
set Color orange
bind .c <1> { NewItem $ItemType %x %y $Color }
bind .c <3> { DeleteItem }
bind . <F1> { console show }
bind . <Escape> { source $argv0 }
every 200 { Animate }
focus -force .
# Debug:
if 0 {
catch {console show}
proc int x { expr int($x) }
bind .c <Motion> {wm title . "[int [%W canvasx %x]],[int [%W canvasy %y]]=[.c find withtag current]"}
}
#.See also: A tiny drawing program - TclBrix - Toy car workshop - Xmas Stars - Xmas Tree