SGI/util/SGI/lib/blt2.4/demos/calendar

   1 #!/home/people/tkys/Eos/util/SGI/bin/bltwish
   2 #!../bltwish
   3
   4 source bltDemo.tcl
   5
   6 set file ./images/chalk.gif
   7 set active ./images/rain.gif
   8
   9 image create photo calendar.texture.1 -file $file
  10 image create photo calendar.texture.2 -file $active
  11
  12 option add *Tile calendar.texture.1
  13
  14 option add *HighlightThickness          0
  15 option add *calendar.weekframe*Tile     calendar.texture.2
  16 option add *Calendar.Label.borderWidth  0
  17 option add *Calendar.Label.relief       sunken
  18 option add *Calendar.Frame.borderWidth  2
  19 option add *Calendar.Frame.relief       raised
  20 option add *Calendar.Label.font         -*-Helvetica-Bold-R-*-*-14-*-*-*-*-*-*-*
  21 option add *Calendar.Label.foreground   white
  22 option add *button.foreground           white
  23 option add *background grey85
  24 option add *button.activeForeground     white
  25 option add *button.activeBackground     blue4
  26
  27 array set monthInfo {
  28     Jan { January 31 }
  29     Feb { February 28 }
  30     Mar { March 31 }
  31     Apr { April 30 }
  32     May { May 31 }
  33     Jun { June 30 }
  34     Jul { July 31 }
  35     Aug { August 31 }
  36     Sep { September 30 }
  37     Oct { October 31 }
  38     Nov { November 30 }
  39     Dec { December 31 }
  40 }
  41
  42 option add *tile calendar.texture.2
  43 set abbrDays { Sun Mon Tue Wed Thu Fri Sat }
  44
  45 proc Calendar { weekday day month year } {
  46     global monthInfo abbrDays
  47
  48     set wkdayOffset [lsearch $abbrDays $weekday]
  49     if { $wkdayOffset < 0 } {
  50         error "Invalid week day \"$weekday\""
  51     }
  52     set dayOffset [expr ($day-1)%7]
  53     if { $wkdayOffset < $dayOffset } {
  54         set wkdayOffset [expr $wkdayOffset+7]
  55     }
  56     set wkday [expr $wkdayOffset-$dayOffset-1]
  57     if { [info commands .calendar] == ".calendar" } {
  58         destroy .calendar
  59     }
  60     frame .calendar -class Calendar -width 3i -height 3i
  61
  62     if ![info exists monthInfo($month)] {
  63         error "Invalid month \"$month\""
  64     }
  65     set info $monthInfo($month)
  66     label .calendar.month \
  67         -text "[lindex $info 0] $year"  \
  68         -font *-New*Century*Schoolbook-Bold-R-*-18-*
  69     table .calendar .calendar.month 1,0 -cspan 7
  70
  71     set cnt 0
  72     frame .calendar.weekframe -relief raised -bd 2
  73     table .calendar .calendar.weekframe 2,0 -columnspan 7 -fill both
  74     foreach dayName $abbrDays {
  75         set name [string tolower $dayName]
  76         label .calendar.$name \
  77             -text $dayName \
  78             -font -*-Helvetica-Bold-R-*-*-16-*-*-*-*-*-*-*
  79         table .calendar .calendar.$name 2,$cnt -pady 2 -padx 2
  80         incr cnt
  81     }
  82     table configure .calendar c* r2 -pad 4
  83     set week 0
  84     set numDays [lindex $info 1]
  85     for { set cnt 1 } { $cnt <= $numDays } { incr cnt } {
  86         label .calendar.day${cnt} -text $cnt
  87         if { $cnt == $day } {
  88             .calendar.day${cnt} configure -relief raised -bd 2
  89         }
  90         incr wkday
  91         if { $wkday == 7 } {
  92             incr week
  93             set wkday 0
  94         }
  95         table .calendar .calendar.day${cnt} $week+3,$wkday -fill both  -pady 4
  96     }
  97     frame .calendar.quit -bd 1 -relief sunken
  98     button .calendar.quit.button -command { exit } -text {Quit} \
  99         -bd 2
 100     table .calendar.quit .calendar.quit.button -padx 4 -pady 4
 101     table .calendar \
 102         .calendar.quit $week+4,5 -cspan 2 -pady 4
 103     table . .calendar -fill both
 104     table configure .calendar r0 -resize none
 105 }
 106
 107 #table . -reqwidth [image width calendar.texture.1] -reqheight [image height calendar.texture.1]
 108
 109 set date [clock format [clock seconds]]
 110 scan $date {%s %s %d %*s %*s %s} weekday month day year
 111
 112 Calendar $weekday $day $month $year
 113 wm minsize . 0 0
 114
 115 bind AutoFocus <Enter> {
 116     focus %W
 117     catch { .calendar.quit configure -tile calendar.texture.2 }
 118 }
 119
 120
 121 bind AutoFocus <Leave> {
 122     focus .
 123     catch { .calendar.quit configure -tile calendar.texture.1 }
 124 }
 125
 126 bindtags .calendar.quit.button { AutoFocus .calendar.quit.button Button all }