/usr/share/blt2.5/examples/calendar.tcl is in blt-demo 2.5.3+dfsg-3.
This file is owned by root:root, with mode 0o755.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 | #!/usr/bin/wish8.6
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
|