QLOCKTWO in Tcl

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" "[email protected]"

# 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