diff options
Diffstat (limited to 'blt/examples/calendar.tcl')
| -rwxr-xr-x | blt/examples/calendar.tcl | 141 |
1 files changed, 141 insertions, 0 deletions
diff --git a/blt/examples/calendar.tcl b/blt/examples/calendar.tcl new file mode 100755 index 00000000000..658bc6f2fea --- /dev/null +++ b/blt/examples/calendar.tcl @@ -0,0 +1,141 @@ +#!../src/bltwish + +package require BLT + +# -------------------------------------------------------------------------- +# Starting with Tcl 8.x, the BLT commands are stored in their own +# namespace called "blt". The idea is to prevent name clashes with +# Tcl commands and variables from other packages, such as a "table" +# command in two different packages. +# +# You can access the BLT commands in a couple of ways. You can prefix +# all the BLT commands with the namespace qualifier "blt::" +# +# blt::graph .g +# blt::table . .g -resize both +# +# or you can import all the command into the global namespace. +# +# namespace import blt::* +# graph .g +# table . .g -resize both +# +# -------------------------------------------------------------------------- + +if { $tcl_version >= 8.0 } { + namespace import blt::* + namespace import -force blt::tile::* +} + +#source scripts/demo.tcl + +set file ../demos/images/chalk.gif +set active ../demos/images/rain.gif + +image create photo calendar.texture.1 -file $file +image create photo calendar.texture.2 -file $active + +option add *Tile calendar.texture.1 + +option add *HighlightThickness 0 +option add *calendar.weekframe*Tile calendar.texture.2 +option add *Calendar.Label.borderWidth 0 +option add *Calendar.Label.relief sunken +option add *Calendar.Frame.borderWidth 2 +option add *Calendar.Frame.relief raised +option add *Calendar.Label.font { Helvetica 11 } +option add *Calendar.Label.foreground navyblue +option add *button.foreground navyblue +option add *background grey85 +option add *button.activeForeground red +option add *button.activeBackground blue4 +option add *Label.ipadX 200 + +array set monthInfo { + Jan { January 31 } + Feb { February 28 } + Mar { March 31 } + Apr { April 30 } + May { May 31 } + Jun { June 30 } + Jul { July 31 } + Aug { August 31 } + Sep { September 30 } + Oct { October 31 } + Nov { November 30 } + Dec { December 31 } +} + +option add *tile calendar.texture.2 +set abbrDays { Sun Mon Tue Wed Thu Fri Sat } + +proc Calendar { weekday day month year } { + global monthInfo abbrDays + + set wkdayOffset [lsearch $abbrDays $weekday] + if { $wkdayOffset < 0 } { + error "Invalid week day \"$weekday\"" + } + set dayOffset [expr ($day-1)%7] + if { $wkdayOffset < $dayOffset } { + set wkdayOffset [expr $wkdayOffset+7] + } + set wkday [expr $wkdayOffset-$dayOffset-1] + if { [info commands .calendar] == ".calendar" } { + destroy .calendar + } + frame .calendar -class Calendar -width 3i -height 3i + + if ![info exists monthInfo($month)] { + error "Invalid month \"$month\"" + } + + set info $monthInfo($month) + label .calendar.month \ + -text "[lindex $info 0] $year" \ + -font { Courier 14 bold } + table .calendar .calendar.month 1,0 -cspan 7 -pady 10 + + set cnt 0 + frame .calendar.weekframe -relief sunken -bd 1 + table .calendar .calendar.weekframe 2,0 -columnspan 7 -fill both + foreach dayName $abbrDays { + set name [string tolower $dayName] + label .calendar.$name \ + -text $dayName \ + -font { Helvetica 12 } + table .calendar .calendar.$name 2,$cnt -pady 2 -padx 2 + incr cnt + } + table configure .calendar c* r2 -pad 4 + set week 0 + set numDays [lindex $info 1] + for { set cnt 1 } { $cnt <= $numDays } { incr cnt } { + label .calendar.day${cnt} -text $cnt + if { $cnt == $day } { + .calendar.day${cnt} configure -relief sunken -bd 1 + } + incr wkday + if { $wkday == 7 } { + incr week + set wkday 0 + } + table .calendar .calendar.day${cnt} $week+3,$wkday \ + -fill both -ipadx 10 -ipady 4 + } + frame .calendar.quit -bd 1 -relief sunken + button .calendar.quit.button -command { exit } -text {Quit} -bd 2 + table .calendar.quit \ + .calendar.quit.button -padx 4 -pady 4 + table .calendar \ + .calendar.quit $week+4,5 -cspan 2 -pady 4 + table . \ + .calendar -fill both + table configure .calendar r0 -resize none + table configure .calendar c0 c6 +} + +set date [clock format [clock seconds] -format {%a %b %d %Y}] +scan $date { %s %s %d %d } weekday month day year + +Calendar $weekday $day $month $year |