#!/bin/sh
# Restart with tcl: -*- mode: tcl; tab-width: 4; -*- \
 exec wish $0 ${1+"$@"}

# https://wiki.tcl-lang.org/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 <Key-F1> About
   bind all <Key-F4> exit
   bind all <Key-F5> { Init .c1 }
   bind all <Key-F6> { 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 <Return> { 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 .  <F2>     { console show }
 bind .  <Escape> { source $argv0 }
 if 0 {
   proc int x  { expr int($x) }
   bind .c1 <Motion> {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 .}

#.