a perpetual calendar

JM Nov 7th 2010, This little toy resembles the key rings that contains a "perpetual calendar", of course we can create such calendar with clock commands, but this time, the objective was to re-create the mechanical shifts of labels on such key rings. you can add more years to this little toy as long as you add them in groups of 7.
On the other hand, it was a good excuse to play with lists and grid commands.

  • You have to align the year with the month using the buttons < and >
  • For leap years (which are marked with an asterisk) make sure you use the month with a yellow highlight

perpetualCalSS

the screenshot above shows the november 2010 calendar, where I underlined today's date 11/28, sunday.

 #console show

 set wkDays [list mon tue wed thu fri sat sun]

 set years [list 2018 2017 2016* ---- 2015 2014 2013\
 2012* ---- 2011 2010 2009 2008* ----\
 2007 2006 2005 2004* ---- 2003 2002\
 2001 2000* ---- 1999 1998 1997 1996*\
 ---- 1995 1994  1993 1992* ---- 1991\
 1990  1989 1988* ---- 1987  1986  1985\
 1984* ---- 1983  1982  1981  1980* ----\
 1979  1978  1977  1976* ----  1975  1974\
 1973  1972* ----  1971  1970  1969  1968*]

 proc refresh {wkDays years} {
 foreach widget {.lblUno .lblDos .lblTres .lblCuatro .lblCinco .lblSeis .lblSiete} valor $wkDays {
        $widget configure -text $valor
 }

 foreach widget {.yr1 .yr2 .yr3 .yr4 .yr5 .yr6 .yr7} valor [lrange $years 0 6] {
        $widget configure -text $valor
 }
 }

 proc shift3 {_L} {
 upvar 1 $_L L 
 set L [concat [lindex $L end] [lrange $L 0 end-1]]
 }

 proc shift4 {_L} {
 upvar 1 $_L L 
 set L [concat [lrange $L 1 end] [lindex $L 0]]
 #puts $L
 }

 proc shift> {} {
 global wkDays years
 shift3 years
 shift4 wkDays

 refresh $wkDays $years
 }

 proc shift< {} {
 global wkDays years
 shift3 wkDays
 shift4 years
 refresh $wkDays $years
 }

 label .title -text "Perpetual Calendar"
 grid .title -columnspan 9

 button .btn> -text ">" -command shift>
 button .btn< -text "<" -command shift<

 for {set i 1} {$i < 8} {incr i} {
 label .yr$i -text "1234"
 }
 grid .btn< .yr1 .yr2 .yr3 .yr4 .yr5 .yr6 .yr7 .btn>

 foreach month {Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec} {
 label .lbl$month -text $month
 }

 label .lblEneB -text "Jan" -bg yellow
 label .lblFebB -text "Feb" -bg yellow
 grid  x .lblEne .lblMay .lblAgo  .lblMar .lblJun .lblDic .lblJul
 grid  x .lblOct x       .lblFebB .lblFeb x       .lblSep .lblAbr
 grid  x x       x       x        .lblNov x       x       .lblEneB

 for {set i 1} {$i < 32} {incr i} {
 label .lbl$i -text "$i"
 }

 foreach dia {Uno Dos Tres Cuatro Cinco Seis Siete} {
 label .lbl$dia -text $dia
 }
 grid x .lblUno .lblDos .lblTres .lblCuatro .lblCinco .lblSeis .lblSiete

 grid x .lbl1 .lbl2 .lbl3 .lbl4 .lbl5 .lbl6 .lbl7
 grid x .lbl8 .lbl9 .lbl10 .lbl11 .lbl12 .lbl13 .lbl14
 grid x .lbl15 .lbl16 .lbl17 .lbl18 .lbl19 .lbl20 .lbl21
 grid x .lbl22 .lbl23 .lbl24 .lbl25 .lbl26 .lbl27 .lbl28
 grid x .lbl29 .lbl30 .lbl31

 for {set i 0} {$i < 9} {incr i} {
 grid columnconfigure . $i -minsize 50
 }

 refresh $wkDays $years