[HJG] This program simulates the candles burning down on an advent-wreath, and keeps track of statistics, such as how many times each candle was lit, and how many times each advent was celebrated. So you can try to maximize the usage you might get out of a set of candles... ---- #!/bin/sh # Restart with tcl: -*- mode: tcl; tab-width: 4; -*- \ exec wish $0 ${1+"$@"} # http://wiki.tcl.tk/20479 - advent10.tcl - 2008-12-20 # Simulate an advent-wreath: select which candles to light, press button to burn # Todo: # * variable number of candles/checkbuttons/stats-displays # * click on candle to toggle checkbox # * delete+redraw --> itemconfig # * use grid for positioning the candles # * log to console # * candleflames + animation # * Options: # ** initial length of candles # ** candle-colors # ... package require Tk global Prg set Prg(Title) "Advent-Wreath" set Prg(Version) "v1.0" set Prg(Date) "2008-12-13" set Prg(Author) "Hans-Joachim Gurt" set Prg(Contact) [string map -nocase {: @ ! .} gurt:gmx!de] set Prg(About) "Simulate an advent-wreath: select which candles to light, press button to burn one slice." proc Init {w t} { #: Init. variables, draw all candles. global candle len active stat for { set i 1 } { $i <= $candle(maxC) } { incr i 1 } { set len($i) $candle(hC) set active($i) 0 set stat(c$i) 0 set stat(a$i) 0 DrawCandle $w $i } set active(1) 1 } proc DrawCandle {w nr} { #: Draw one of the candles / calculate its position on the canvas. global candle len stat set c red2 set ww [expr { $candle(sC) + $candle(wC) } ] set x1 [expr { $candle(sC) + ($nr-1) * $ww } ] set x2 $x1 incr x2 $candle(wC) set y1 [expr { $candle(hC) + 50 } ] set y2 [expr { $y1 - $len($nr) } ] # Candle: .cv create rect $x1 $y1 $x2 $y2 -width 1 -fill $candle(cC) -tag "c$nr" # Holder: incr x1 -5 incr x2 5 set y2 $y1 incr y1 10 .cv create rect $x1 $y1 $x2 $y2 -width 1 -fill gold -tag "c$nr" } proc Burn {w nr} { #: Burn one slice of selected candles + update statistics. global candle len active stat set ok 1 set adv 0 for { set i 1 } { $i <= $candle(maxC) } { incr i 1 } { if $active($i) { if { $::len($i) < $::candle(bC) } { set ok 0; bell; } incr adv 1 } } if $ok { incr stat(a$adv) 1 for { set nr 1 } { $nr <= $candle(maxC) } { incr nr 1 } { if $active($nr) { set ::len($nr) [expr { $::len($nr) - $::candle(bC) } ] $w delete "c$nr" DrawCandle $w $nr incr stat(c$nr) 1 } } } } #---+----1----+----2----+----3----+----4----+----5----+----6----+----7-- wm title . $Prg(Title) if {[file exists advent.ico]} { wm iconbitmap . advent.ico } frame .f1 ;# display frame .f2 ;# buttons frame .f3 ;# candle-stats frame .f4 ;# advent-stats pack .f1 .f2 .f3 .f4 # Candle-attributes: totalnumber, height,width, spacing, burn, color array set candle { maxC 4 hC 125 wC 50 sC 50 bC 10 cC red2 } for { set i 1 } { $i <= $candle(maxC) } { incr i 1 } { checkbutton .cb$i -variable active($i) -text $i entry .ec$i -textvar stat(c$i) -width 5 -state readonly entry .ea$i -textvar stat(a$i) -width 5 -state readonly } set maxY [expr { $candle(hC) + 100 } ] set maxX [expr { $candle(maxC) * ($candle(wC) + $candle(sC)) + 50 } ] canvas .cv -width $maxX -height $maxY -bg white pack .cv -in .f1 button .bN -text "New" -command { Init .cv "Canvas" } button .b1 -text "Burn" -command { Burn .cv 1 } pack .bN .cb1 .cb2 .cb3 .cb4 .b1 -in .f2 -side left -padx 2 label .lab1 -text "Candle burnt:" -width 14 label .lab2 -text "Advent:" -width 14 label .lab0 -text " " -width 16 label .lab9 -text " " -width 16 pack .lab1 .ec1 .ec2 .ec3 .ec4 .lab0 -in .f3 -side left -padx 2 pack .lab2 .ea1 .ea2 .ea3 .ea4 .lab9 -in .f4 -side left -padx 2 Init .cv "Canvas" focus -force . # Debug: bind . { console show } bind . { source $argv0 } if 0 { proc int x { expr int($x) } bind .cv {wm title . "[int [%W canvasx %x]],[int [%W canvasy %y]]=[.cv find withtag current]"} } #catch {console show} #catch {wm withdraw .} #. ---- Not all planned features are implemented yet, but I wanted this to get out before christmas... ---- [Category Graphics] - [Category Toys]