JM 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 is a good excuse to play with lists and grid commands.
#console show
set wkDays list lun mar mie jue vie sab dom
puts $wkDays puts $years puts "--------"
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] puts $L }
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 "Calendario Perpetuo" grid .title -columnspan 9
button .btn> -text ">" -command shift> button .btn< -text "<" -command shift<
for {set i 1} {$i < 8} {incr i} { #puts $i label .yr$i -text "1234" } grid .btn< .yr1 .yr2 .yr3 .yr4 .yr5 .yr6 .yr7 .btn>
foreach month {Ene Feb Mar Abr May Jun Jul Ago Sep Oct Nov Dic} { label .lbl$month -text $month }
label .lblEneB -text "Ene" -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} { puts $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