[HJG] Inspired by [Xmas Tree] from [RS], here you can decorate the tree yourself. * Click to place a new decoration * Right-click to remove an item * 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 # See also Xmas Tree by R. Suchenwirth 2005-12-22, http://wiki.tcl.tk/15164 # # Click to place new decorations # Right-click to remove # Cut+paste your design from console to proc Decorate # # 2005-12-23 First Version # Todo: # Save to image/jpg, load/save layout (serialize to file), # move items, # more generic / resizable tree, # more decoration-items (lametta, bells, 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] } 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 } $i ] if { $i=="random" } { set ItemType [lpick {C 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 { C { NewCandle $x $y $c } 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 } } } proc NewCandle {x1 y1 {c red}} { set x2 [expr $x1 + 4] .c create rect $x1 $y1 \ $x2 [expr $y1-20] -fill $c -tags "candle i$::nItem" .c create oval [expr $x1-1] [expr $y1-21] \ [expr $x2+1] [expr $y1-30] -fill yellow -tags "flame i$::nItem" puts "C $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 {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 + $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" } proc Flicker {id} { #: Fast color-cycling to flicker a candle-flame set Color [lpick {yellow linen white orange gold "light yellow" goldenrod red red2}] .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] } } 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 C 56 124 red C 16 241 red C 159 164 red b4 75 142 cyan b6 128 236 red b8 164 208 gray s4 72 201 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 cyan blue magenta white gray random tk_optionMenu .m2 ItemType Candle 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 "Candle" set Color "random" set Color orange bind .c <1> { NewItem $ItemType %x %y $Color } bind .c <3> { DeleteItem } every 200 { Animate } # 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]"} } #. ---- [Category Graphics] | [Category Toys]