#
# Calendar for Tcl/Tk V1.0
# Copyright (C) 1999-2003 Satoshi Imai
#
lappend holiday {{* 1 1} 元旦}
lappend holiday {{1999 1 15} 成人の日}
lappend holiday {{2000 1 10} 成人の日}
lappend holiday {{* 2 11} 建国記念の日}
lappend holiday {{1999 3 21} 春分の日}
lappend holiday {{2000 3 20} 春分の日}
lappend holiday {{* 4 29} みどりの日}
lappend holiday {{* 5 3} 憲法記念日}
lappend holiday {{* 5 4} 国民の日}
lappend holiday {{* 5 5} こどもの日}
lappend holiday {{* 7 20} 海の日}
lappend holiday {{* 9 15} 敬老の日}
lappend holiday {{1999 9 23} 秋分の日}
lappend holiday {{* 10 10} 体育の日}
lappend holiday {{* 11 3} 文化の日}
lappend holiday {{* 11 23} 勤労感謝の日}
lappend holiday {{* 12 23} 天皇誕生日}
#
#lappend memorial {{* 1 22} 入籍記念日}
#lappend memorial {{* 3 8} 結婚記念日}
#lappend memorial {{* 10 21} みどり誕生日}
#lappend memorial {{* 12 18} 智誕生日}

if { $tcl_platform(platform) == "windows" } {
    set font {{Times New Roman} 14}
} else {
    set font {rk14}
}
set bgcolor white

set oneday [expr 60*60*24]
set todaymark 1
set memorialmark 1

proc getdate {} {
    global curyear curmonth curday today
    set today [clock format [clock second] -format "%Y %m %d"]
    set curyear [lindex $today 0]
    regsub "^0" [lindex $today 1] {} curmonth
    regsub "^0" [lindex $today 2] {} curday
    set today "$curyear $curmonth $curday"
}

proc nextmonth {month year} {
    if {$month == 12} {
        incr year
        return "1/1/$year"
    } else {
        incr month
        return "$month/1/$year"
    }
}

proc calcfont {} {
    global fontw fonth font
    label .test -text 12 -width 2 -height 1 -font $font
    set fontw [winfo reqwidth .test]
    set fonth [winfo reqheight .test]
    destroy .test
}

proc calendar {year month x y w h} {
    global oneday today todaymark font font2 holiday memorial memorialmark
    set week [clock format [clock scan $month/1/$year] -format "%w"]
    if [catch {clock format [expr [clock scan [nextmonth $month $year]] - $oneday] -format "%d"} end] {
        set end 31
        foreach day {31 30 29} {
            if [catch {clock scan $month/$day/$year}] {
            incr end -1
            }
        }
    }
    set i 0
    foreach l {S M Tu W Th F S} {
        if {$i%7 == 0} {
            set color red
        } elseif {$i%7 == 6} {
            set color blue
        } else {
            set color black
        }
        .can create text [expr ($i%7)*$w+$x] [expr ($i/7)*$h+$y] -text $l -anchor c -font $font -fill $color
        incr i
    }
    set furikae 0
    for {set j 0;set n 1} {$j < 42} {incr i;incr j} {
        if {$j < $week || $n > $end} {
            continue
        } else {
            if {$i%7 == 0} {
                set color red
            } elseif {$i%7 == 6} {
                set color blue
            } else {
                set color black
                if {$furikae == 1} {
                    set color red
                    set furikae 0
                }
            }
            foreach hol $holiday {
                set date [lindex $hol 0]
                set hy [lindex $date 0]
                if {$hy == "*"} {
                    set hy $year
                }
                if {$year == $hy && $month == [lindex $date 1] && $n == [lindex $date 2]} {
                    set color red
                    if {$i%7 == 0} {
                        set furikae 1
                    }
                    break
                }
            }
            .can create text [expr ($i%7)*$w+$x] [expr ($i/7)*$h+$y] -text $n -anchor c -font $font -fill $color -tag tag$month.$n
            if {$todaymark == 1 && [lindex $today 2] == $n && [lindex $today 1] == $month && [lindex $today 0] == $year} {
                .can create rectangle [expr ($i%7)*$w+$x-($w/2)] [expr ($i/7)*$h+$y-($h/2)] \
                [expr ($i%7)*$w+$x+($w/2)] [expr ($i/7)*$h+$y+($h/2)] -outline blue
            }
#           if {$memorialmark == 1} {
#               foreach mem $memorial {
#                   set date [lindex $mem 0]
#                   set my [lindex $date 0]
#                   if {$my == "*"} {
#                       set my $year
#                   }
#                   if {$year == $my && $month == [lindex $date 1] && $n == [lindex $date 2]} {
#                       .can create oval [expr ($i%7)*$w+$x-($w/2)] [expr ($i/7)*$h+$y-($h/2)] \
#                       [expr ($i%7)*$w+$x+($w/2)] [expr ($i/7)*$h+$y+($h/2)] -outline blue
#                   }
#               }
#           }
            incr n
        }
    }
    .can create text [expr $x+$w*3] [expr $y-$h] -text "$year / $month" -font $font
}

proc cal_month {year month} {
    global fontw fonth bgcolor
    set ww [expr $fontw+$fontw/2]
    set hh [expr $fonth+$fonth/2]
    set sw [winfo screenwidth .]
    set sh [winfo screenheight .]
    set cw [expr $ww+$fontw*8]
    set ch [expr $hh+$fonth*7]
    .can addtag tag all; .can delete tag
    .can create rectangle 0 0 $cw $ch -fill $bgcolor -outline $bgcolor
    if {$cw > $sw} {set cw $sw}
    if {$ch > $sh} {set ch $sh}
#   if {$cw == $sw || $ch == $sh} {
#       .can configure -width [expr $cw*.8] -height [expr $ch*.7]
#   } else {
#       .can configure -width [expr $cw] -height [expr $ch]
#   }
    calendar $year $month $ww $hh $fontw $fonth
}

proc refresh {} {
    global curyear curmonth
    calcfont
    .mprev configure -state normal
    .mnext configure -state normal
    cal_month $curyear $curmonth
}

pack [frame .top] -fill x
button .yprev -text " << " -command {
    incr curyear -1
    if {$curyear == 1970} {
        set curyear 1971
    }
    refresh
}
button .mprev -text " < " -command {
    incr curmonth -1
    if {$curmonth == 0} {
        set curmonth 12
        .yprev invoke
    }
    refresh
}
button .today -text "Today" -command {
    getdate
    refresh
}
button .mnext -text " > " -command {
    incr curmonth
    if {$curmonth == 13} {
        set curmonth 1
        .ynext invoke
    }
    refresh
}
button .ynext -text " >> " -command {
    incr curyear
    if {$curyear == 2038} {
        set curyear 2037
    }
    refresh
}
pack .yprev .mprev .today .mnext .ynext -side left -in .top -padx 0 -pady 0 -fill x -expand 1
pack [canvas .can] -padx 0 -pady 0 -fill x -expand 1

.today invoke
# end of file