FS: When I saw the QLOCKTWO clock from Biegert & Funk (www.qlocktwo.com ) I was really fascinated by the idea. And I thought that it should not be too hard to program such a clock in Tcl as well. So while watching TV on a Saturday evening, I wrote this little Tcl script which comes pretty close to the original hardware. Btw, this is the German version of the clock but it should not be too complicated to change it into another language.
#!/bin/sh
# the next line restarts using tclsh \
exec wish "$0" "$@"
# This is a Tcl/Tk implementation of the QLOCKTWO from Biegert & Funk
# www.qlocktwo.de
proc createClockWidget {w} {
global widget
# The text for the German version
set clockText \
{{E S K I S T A F Ü N F} \
{Z E H N Z W A N Z I G} \
{D R E I V I E R T E L} \
{V O R F U N K N A C H} \
{H A L B A E L F Ü N F} \
{E I N S X Ä M Z W E I} \
{D R E I A U J V I E R} \
{S E C H S N L A C H T} \
{S I E B E N Z W Ö L F} \
{Z E H N E U N K U H R}}
set width 700
set offset 80
set widget $w.canvas
canvas $widget \
-width $width -height $width \
-background black
# Create a text element for each letter
font create f -family Swiss -size 20
for {set i 0} {$i < 10} {incr i} {
for {set j 0} {$j < 11} {incr j} {
set c [lindex [lindex $clockText $i] $j]
$widget create text \
[expr $offset + $j * ($width - $offset * 2) / 10] \
[expr $offset + $i * ($width - $offset * 2) / 9] \
-justify center -anchor c -text $c \
-fill darkslategrey -font f -tag [list all $j,$i]
}
}
# Now create four rectangles in the corners for minutes 1 to 4 and 6 to 9.
$widget create rec \
[expr $offset / 2 - 2] [expr $offset / 2 - 2] \
[expr $offset / 2 + 2] [expr $offset / 2 + 2] \
-fill darkslategrey -tag [list all min1]
$widget create rec \
[expr $width - ($offset / 2) - 2] [expr ($offset / 2) - 2] \
[expr $width - ($offset / 2) + 2] [expr ($offset / 2) + 2] \
-fill darkslategrey -tag [list all min2]
$widget create rec \
[expr $width - $offset / 2 - 2] [expr $width - $offset / 2 - 2] \
[expr $width - $offset / 2 + 2] [expr $width - $offset / 2 + 2] \
-fill darkslategrey -tag [list all min3]
$widget create rec \
[expr $offset / 2 - 2] [expr $width - $offset / 2 - 2] \
[expr $offset / 2 + 2] [expr $width - $offset / 2 + 2] \
-fill darkslategrey -tag [list all min4]
pack $widget
return
}
# Sets all letters to grey and then highlites the letters with the coordinates
# given in coorList.
# coorList is a list of horizontal lines: {x0 y0 x1 y1} {x2 y2 x3 y3} ...
# x0 and x1 are expected to be equal.
proc highliteTime {coorList} {
global widget
$widget itemconfigure all -fill darkslategrey
foreach coor $coorList {
set i [lindex $coor 0]
for {set j [lindex $coor 1]} {$j <= [lindex $coor 3]} {incr j} {
$widget itemconfigure $j,$i -fill white
}
}
update
return
}
# This is the main function. It gets the current time and creates coordinate lists which are
# passed to the function highliteTime.
# After 15 seconds (reduce this value if you need your seconds updated earlier) the updateTime
# calls itself again.
proc updateTime {} {
global widget
# Get the current time
set time [clock format [clock seconds] -format "%l %M"]
# Hours
set h [lindex $time 0]
# Minutes
set m [lindex $time 1]
# Remove a leading zero from minutes
if {[string index $m 0] == 0} {
set m [string index $m 1]
}
# First two words "It is" (Es ist)
set coorList {{0 0 0 1} {0 3 0 5}}
# Appends the words for "a quarter past" ("Viertel nach"),
# "half past" (Halb") etc.
if {($m >= 0) && ($m < 5)} {
} elseif {($m >= 5) && ($m < 10)} {
lappend coorList {0 7 0 10} {3 7 3 10}
} elseif {($m >= 10) && ($m < 15)} {
lappend coorList {1 0 1 3} {3 7 3 10}
} elseif {($m >= 15) && ($m < 20)} {
lappend coorList {2 4 2 10} {3 7 3 10}
} elseif {($m >= 20) && ($m < 25)} {
lappend coorList {1 4 1 10} {3 7 3 10}
} elseif {($m >= 25) && ($m < 30)} {
lappend coorList {0 7 0 10} {3 0 3 2} {4 0 4 3}
incr h
} elseif {($m >= 30) && ($m < 35)} {
lappend coorList {4 0 4 3}
incr h
} elseif {($m >= 35) && ($m < 40)} {
lappend coorList {0 7 0 10} {3 7 3 10} {4 0 4 3}
incr h
} elseif {($m >= 40) && ($m < 45)} {
lappend coorList {1 4 1 10} {3 0 3 2}
incr h
} elseif {($m >= 45) && ($m < 50)} {
lappend coorList {2 4 2 10} {3 0 3 2}
incr h
} elseif {($m >= 50) && ($m < 55)} {
lappend coorList {1 0 1 3} {3 0 3 2}
incr h
} elseif {($m >= 55) && ($m < 60)} {
lappend coorList {0 7 0 10} {3 0 3 2}
incr h
}
if {$h == 13} {
set h 1
}
# The word for the hours
switch -exact $h {
1 {
# Distinction between "Ein" (Ein Uhr) and "Eins" ("vor eins")
if {($m >= 0) && ($m < 5)} {
set coor {5 0 5 2}
} else {
set coor {5 0 5 3}
}
}
2 {
set coor {5 7 5 10}
}
3 {
set coor {6 0 6 3}
}
4 {
set coor {6 7 6 10}
}
5 {
set coor {4 7 4 10}
}
6 {
set coor {7 0 7 4}
}
7 {
set coor {8 0 8 5}
}
8 {
set coor {7 7 7 10}
}
9 {
set coor {9 3 9 6}
}
10 {
set coor {9 0 9 3}
}
11 {
set coor {4 5 4 7}
}
12 {
set coor {8 6 8 10}
}
}
lappend coorList $coor
# Append "o'clock" ("Uhr")
if {($m >= 0) && ($m < 5)} {
lappend coorList {9 8 9 10}
}
highliteTime $coorList
# Highlite the remaining minutes as rectangles in the corners
switch -exact [expr $m % 10] {
1 -
6 {
$widget itemconfigure min1 -fill white
}
2 -
7 {
$widget itemconfigure min1 -fill white
$widget itemconfigure min2 -fill white
}
3 -
8 {
$widget itemconfigure min1 -fill white
$widget itemconfigure min2 -fill white
$widget itemconfigure min3 -fill white
}
4 -
9 {
$widget itemconfigure min1 -fill white
$widget itemconfigure min2 -fill white
$widget itemconfigure min3 -fill white
$widget itemconfigure min4 -fill white
}
}
# Call the function again after a 15 seconds
after 15000 updateTime
}
# Create the canvas widget, set the window title and start the clock (updateTime)
createClockWidget ""
wm title . QLOCKTWO
updateTime