[HJG] Inspired by [Xmas Tree] from [RS], here is a version where you can decorate the tree yourself. * Use option-menus to select color and type of decoration * Click on canvas to place it * Right-click to remove an item * F1 to show console * Cut+paste your design from the console-log to the proc Decorate 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 . { console show } bind . { source $argv0 } every 200 { Animate } focus -force . # Debug: if 0 { catch {console show} proc int x { expr int($x) } bind .c {wm title . "[int [%W canvasx %x]],[int [%W canvasy %y]]=[.c find withtag current]"} } #. ---- See also: [TclBrix] - [Toy car workshop] - [A tiny drawing program] - [Xmas Stars] - [Xmas Tree] ---- [Category Graphics] | [Category Toys]