[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.
----
 #!/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
 # * delete+redraw --> itemconfig
 # * use grid for positioning the candles
 # * log
 # * animated candleflame
 # * Options:
 # ** initial length of candles
 # ** 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 .  <F1>     { console show }
  bind .  <Escape> { source $argv0 }

  if 0 {
  proc int x  { expr int($x) }
  bind .cv <Motion> {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]