[HJG] 2008-12 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. Every time 'burn' is selected, the candles are burned for certain time, e.g. one hour. 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 - advent20.tcl - 2009-01-10 # Simulate an advent-wreath: select which candles to light, press button to burn # 1.1 2008-12-21: log to console # 1.2 2008-12-22: wick # 1.3 2008-12-23: bind, Click, tk_optionMenu for initial length of candles # 1.4 2008-12-24: Click, CountButtons, CheckButtons : # click on candle to toggle checkbox + update text on "Burn"-button # 1.5 2008-12-25: len -> burncount, Flame/Smoke # 1.6 2008-12-26: code cleanup # 1.7 2008-12-27: smoke, inner+outer flame # 1.9 2009-01-09: Menu, Options/candle-colors # 2.0 2009-01-10: Hotkeys for checkbuttons # Todo: # * variable number of candles/checkbuttons/stats-displays # * allow initial state with candles of different length # * load/save - F3 # * delete+redraw --> itemconfig # * show stats on candle/holder: current len, burn-count # * disable checkboxes of burnt-out candles # * use grid for positioning the candles # * candleflames + animation # * icon in program itself: include data for iconbitmap # * selfrunning Demo # ... package require Tk global Prg set Prg(Title) "Advent-Wreath" set Prg(Version) "v2.0" set Prg(Date) "2009-01-10" set Prg(Author) "Hans-Joachim Gurt" set Prg(Contact) [string map -nocase {: @ ! .} gurt:gmx!de] set Prg(About) "Simulates the candles on an advent-wreath:\nselect which candles to light, press button to burn one slice." proc ClrCanvas {w} { $w delete "all" } proc decr {x y} { expr $x - $y } #---+----1----+----2----+----3----+----4----+----5----+----6----+----7----+ proc About {} { #: Short info about the program global Prg set txt "$Prg(Title) $Prg(Version) - " append txt "$Prg(Date)\nby $Prg(Author) - $Prg(Contact)\n\n$Prg(About)" tk_messageBox -icon info -message $txt -title "About $Prg(Title) $Prg(Version)" } proc InitMenu {} { #: Install menu option add *Menu.tearOff 0 . config -menu [menu .menu] menu .menu.game .menu add cascade -label "File" -underline 0 -menu .menu.game .menu.game add command -label "New" -command { Init .c1 } -underline 0 \ -accelerator "F5" .menu.game add command -label "Burn" -command { Burn .c1 } -underline 0 \ -accelerator "F6" .menu.game add separator .menu.game add command -label "Exit" -underline 1 -command exit \ -accelerator "F4" menu .menu.opt .menu add cascade -label "Options" -underline 0 -menu .menu.opt .menu.opt add cascade -label "Color" -menu .menu.opt.col -underline 0 menu .menu.opt.col foreach {cn cv} [list Red red2 Pink HotPink1 Yellow Yellow1 Beewax goldenrod Green green3 Blue CadetBlue2 White beige ] { .menu.opt.col add radio -label $cn \ -variable ::candle(cC) \ -value $cv \ -underline 0 \ -command { Init .c1 } } .menu.opt add cascade -label "Length" -menu .menu.opt.len -underline 0 menu .menu.opt.len for { set i 2 } { $i <= 20 } { incr i 1 } { .menu.opt.len add radio -label "$i" \ -variable ::candle(iC) -value $i \ -command { Init .c1 } } menu .menu.help .menu add cascade -label "Help" -underline 0 -menu .menu.help .menu.help add command -label "About" -underline 0 -command About\ -accelerator "F1" .menu.help add separator .menu.help add command -label "Console" -underline 0 -command { console show } \ -accelerator "F2" bind all About bind all exit bind all { Init .c1 } bind all { Burn .c1 } } #---+----1----+----2----+----3----+----4----+----5----+----6----+----7----+ proc DrawCandle {w nr} { #: Draw one of the candles / calculate its position on the canvas global candle len active stat $w delete "c$nr" 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 { $::maxY - 40 } ] set ll [expr { $len($nr) * $candle(bC) + $candle(hC) } ] set y2 [expr { $y1 - $ll } ] # Candle: .c1 create rect $x1 $y1 $x2 $y2 -width 1 -fill $candle(cC) -tag "c$nr x" # Holder: incr x1 -5 incr x2 5 set y2 $y1 incr y1 10 .c1 create rect $x1 $y1 $x2 $y2 -width 1 -fill gold -tags "c$nr h" # Wick: set c grey if { $len($nr) < $::candle(iC) } { set c black } set x1 [expr { $candle(sC) + ($nr-1) * $ww + 22 } ] set x2 $x1 incr x2 3 set ll [expr { $len($nr) * $candle(bC) + $candle(hC) } ] set y1 [expr { $::maxY - 40 - $ll } ] set y2 $y1 incr y2 -15 .c1 create rect $x1 $y1 $x2 $y2 -width 1 -fill $c -tag "c$nr w" # Flame/Smoke: if $active($nr) { ;# not selected: draw nothing if { $len($nr) < 1 } { ;# Candle burnt out: draw smoke incr x1 -10 incr x2 10 incr y1 -7 incr y2 -35 set yM $y1 incr yM -18 .c1 create line $x1 $y1 $x2 $yM $x1 $yM $x2 $y2 \ -fill grey -width 8 \ -capstyle round -joinstyle round \ -smooth bezier -splinesteps 4 \ -tag "c$nr s" } else { ;# inner flame blue, outer flame yellow # to query color in console: puts [.c1 itemcget [.c1 find withtag fb] -fill ] incr x1 -3 incr x2 3 incr y1 -5 incr y2 -12 .c1 create oval $x1 $y1 $x2 $y2 -width 1 -fill SteelBlue2 -tag "c$nr fb" incr x1 -7 incr x2 7 incr y1 2 incr y2 -23 .c1 create oval $x1 $y1 $x2 $y2 -width 1 -fill yellow -tag "c$nr fy" .c1 raise "fb" } } } #---+----1----+----2----+----3----+----4----+----5----+----6----+----7----+ proc Burn {w} { #: 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) < 1 } { set ok 0; bell; puts "fail: $i"; return } incr adv 1 } } if {$ok && $adv} { incr stat(a$adv) 1 puts -nonewline "Advent $adv - Candles:" for { set nr 1 } { $nr <= $candle(maxC) } { incr nr 1 } { if $active($nr) { incr len($nr) -1 DrawCandle $w $nr incr stat(c$nr) 1 puts -nonewline " $nr" } } puts " " } } #---+----1----+----2----+----3----+----4----+----5----+----6----+----7----+ proc Click {w} { #: When clicking on a candle, toggle the corresponding checkbutton set i 0 set Tags [$w itemcget current -tag ] scan $Tags "%c%d%s" x i y ## puts "$Tags: $i" if { $i } { .cb$i invoke } } proc CheckButtons {w} { #: Check how many checkbuttons are active, update "Burn"-Button and candle/flame global candle len active stat set adv 0 for { set i 1 } { $i <= $candle(maxC) } { incr i 1 } { if $active($i) { incr adv 1 } DrawCandle $w $i } if {$adv} { .b1 configure -text "Advent $adv" -state active } else { .b1 configure -text " - - - - - " -state disabled } } proc Init {w} { #: Assign variables, draw all candles global candle len active stat $w delete "all" puts "# New: $candle(iC)" for { set i 1 } { $i <= $candle(maxC) } { incr i 1 } { set len($i) $candle(iC) set active($i) 0 set stat(c$i) 0 set stat(a$i) 0 DrawCandle $w $i } # set active(1) 1 .cb1 invoke } #---+----1----+----2----+----3----+----4----+----5----+----6----+----7----+--- #: Main wm title . "$Prg(Title) $Prg(Version)" puts "$Prg(Title) $Prg(Version)" 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-attr.: totalnumber, color, init, height0,width, spacing, burn-amount array set candle { maxC 4 cC red2 iC 10 hC 2 wC 50 sC 50 bC 10 } #set maxX 450 set maxX [expr { $candle(maxC) * ($candle(wC) + $candle(sC)) + 50 } ] #set maxY [expr { $candle(hC) + $candle(iC) * $candle(bC) + 100 } ] set maxY 305 ;# room for candles of length 20 for { set i 1 } { $i <= $candle(maxC) } { incr i 1 } { checkbutton .cb$i -variable active($i) -text $i -command { CheckButtons .c1 } entry .ec$i -textvar stat(c$i) -width 5 -state readonly entry .ea$i -textvar stat(a$i) -width 5 -state readonly set k1 "Key-$i" set k2 "Key-KP_$i" set c ".cb$i" ##puts "$i: $k1 $k2 $c" bind all <$k1> [list $c invoke] bind all <$k2> [list $c invoke] } canvas .c1 -width $maxX -height $maxY -bg white pack .c1 -in .f1 tk_optionMenu .m1 ::candle(iC) 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 .m1 configure -width 3 button .bN -text "New" -command { Init .c1 } button .b1 -text "Burn" -command { Burn .c1 } -width 8 bind all { Burn .c1 } ##Todo: var. number of checkbuttons+displays / put on canvas at candle pack .m1 .bN .cb1 .cb2 .cb3 .cb4 .b1 -in .f2 -side left -padx 2 label .lab1 -text "Candle burnt:" -width 21 label .lab2 -text "Advent:" -width 21 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 # Debug: bind . { console show } bind . { source $argv0 } if 0 { proc int x { expr int($x) } bind .c1 {wm title . "[int [%W canvasx %x]],[int [%W canvasy %y]]=[.c1 find withtag current]"} set ::candle(iC) 3 } InitMenu Init .c1 bind .c1 <1> { Click .c1 } focus -force . #catch {console show} #catch {wm withdraw .} #. ---- Updated, mostly to allow to select the starting candle-length. Clicking on a candle also toggles the corresponding checkbox. F2 activates a console, that shows a log of all actions. '''HJG''' 2009-01-11 - Now v2.0 with proper menu, options for candle-colors, and hotkeys. I.e. 1,2,3,4 and enter-key can be used to select candles and burn one slice of them. Next project: [Advent calendar] ---- [Category Graphics] - [Category Toys]