**Summary**
[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 a slice of a certain time, e.g. one hour.
So you can try to maximize the usage you might get out of a set of candles of a given length.
**Code**
----
======tcl
#!/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 .}
#.
======
----
**Comments**
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]
x
<> Graphics | Toys