75 lines
2.1 KiB
Tcl
75 lines
2.1 KiB
Tcl
package require Tcl 8.5
|
|
|
|
# Produce information about the days in a month, without any assumptions about
|
|
# what those days actually are.
|
|
proc calMonthDays {timezone locale year month} {
|
|
set days {}
|
|
set moment [clock scan [format "%04d-%02d-00 12:00" $year $month] \
|
|
-timezone $timezone -locale $locale -format "%Y-%m-%d %H:%M"]
|
|
while 1 {
|
|
set moment [clock add $moment 1 day]
|
|
lassign [clock format $moment -timezone $timezone -locale $locale \
|
|
-format "%m %d %u"] m d dow
|
|
if {[scan $m %d] != $month} {
|
|
return $days
|
|
}
|
|
lappend days $moment [scan $d %d] $dow
|
|
}
|
|
}
|
|
|
|
proc calMonth {year month timezone locale} {
|
|
set dow 0
|
|
set line ""
|
|
set lines {}
|
|
foreach {t day dayofweek} [calMonthDays $timezone $locale $year $month] {
|
|
if {![llength $lines]} {lappend lines $t}
|
|
if {$dow > $dayofweek} {
|
|
lappend lines [string trimright $line]
|
|
set line ""
|
|
set dow 0
|
|
}
|
|
while {$dow < $dayofweek-1} {
|
|
append line " "
|
|
incr dow
|
|
}
|
|
append line [format "%2d " $day]
|
|
set dow $dayofweek
|
|
}
|
|
lappend lines [string trimright $line]
|
|
}
|
|
|
|
proc cal3Month {year month timezone locale} {
|
|
# Extract the month data
|
|
set d1 [lassign [calMonth $year $month $timezone $locale] t1]; incr month
|
|
set d2 [lassign [calMonth $year $month $timezone $locale] t2]; incr month
|
|
set d3 [lassign [calMonth $year $month $timezone $locale] t3]
|
|
# Print the header line of month names
|
|
foreach t [list $t1 $t2 $t3] {
|
|
set m [clock format $t -timezone $timezone -locale $locale -format "%B"]
|
|
set l [expr {10 + [string length $m]/2}]
|
|
puts -nonewline [format "%-25s" [format "%*s" $l $m]]
|
|
}
|
|
puts ""
|
|
# Print the month days
|
|
foreach l1 $d1 l2 $d2 l3 $d3 {
|
|
puts [format "%-25s%-25s%s" $l1 $l2 $l3]
|
|
}
|
|
}
|
|
|
|
proc cal {{year ""} {timezone :localtime} {locale en}} {
|
|
if {$year eq ""} {
|
|
set year [clock format [clock seconds] -format %Y]
|
|
}
|
|
puts [format "%40s" "-- $year --"]
|
|
foreach m {1 4 7 10} {
|
|
puts ""
|
|
cal3Month $year $m $timezone $locale
|
|
}
|
|
}
|
|
|
|
proc snoopy {} {
|
|
puts [format "%43s\n" {[Snoopy Picture]}]
|
|
}
|
|
|
|
snoopy
|
|
cal
|