HoMi-(2008-12-04) The story continuous:
On both pages mentioned above I have stated that it could possible to program a 100% flicker free transparent digital clock. Now I know it is possible.
I gave the program a complete redesign and spend them some nice additional features.
This features are:
And again, sorry for some mistakes in language and grammar but I'm not a english native speaker. Feel free to correct these mistakes, but after this remove this remark. Thanks and have fun.
And here comes the code:
###########################################################################
# FullyTransparentDigitalClock2.tcl --
#
# idea by slebetman
# 100% flicker-free and configurable version by HoMi
#
# usage:
# - to show the config dialog, click on a segment of a digit
# - to use a changed configuration without leaving the config dialog,
# click the Apply button
# - to use a changed configuration and leave the config dialog, click
# the OK button
# - to leave the config dialog without making any changes, click the
# Cancel button
# - to exit the clock, click on the X button of the config dialog
###########################################################################
# to make it starkit-able
package require Tk
###########################################################################
# configuration
# read configuration from a ressource file if it exist
# if not use a base configuration
set rcFile [file join [file dirname [info script]] .clockrc]
if {![catch {set resfile [open $rcFile]}]} {
array set config [read $resfile]
} else {
set config(position) URC ;# base position of the clock:\
Upper Right Corner
set config(style) 24 ;# clock style 12h/24h
set config(showDelims) 1 ;# show delimiters
set config(showSecs) 1 ;# show seconds
set config(color) green ;# segment color
set config(segSize) 10 ;# size of one segment
set config(digitWidth) 5 ;# width of one digit
set config(digitHeight) 9 ;# height of one digit
}
###########################################################################
# segment data
#
# coords for each segment:
# name {X Y width height}
array set segmentData {
a {1 0 3 1}
b {0 1 1 3}
c {4 1 1 3}
d {1 4 3 1}
e {0 5 1 3}
f {4 5 1 3}
g {1 8 3 1}
:1 {0 2 1 1}
:2 {0 6 1 1}
}
# required segments to show the whole digit
# digit {required segments}
array set segmentData {
allSegs {a b c d e f g}
0 {a b c e f g}
1 { c f }
2 {a c d e g}
3 {a c d f g}
4 { b c d f }
5 {a b d f g}
6 {a b d e f g}
7 {a c f }
8 {a b c d e f g}
9 {a b c d f g}
delim {:1 :2}
}
###########################################################################
# initialise clock array - this array holds the
# current configuration and state values of the clock
#
# description of the elements within the clock array:
# position
# style
# showSecs
# showDelims
# color
# segSize
# the meaning of the elements above is the same as in the config
# array
# baseX - upper left corner of the clock display in pixels
# baseY
# digitHeight - the digit height in pixels
# digitWidth - the digit width in pixels
# h1 - the tens digit value of the current hour value
# h2 - the unit digit value of the current hour value
# m1 - the tens digit value of the current minute value
# m2 - the unit digit value of the current minute value
# s1 - the tens digit value of the current second value
# s2 - the unit digit value of the current second value
# halfSec - this flag is used to let the delimiters blink
# draw - this flag is used to avoid drawing and refreshing of
# the clock at the same time
set clock(draw) 0
###########################################################################
# DrawSegment --
#
# draw a segment of a digit
#
#Arguments:
# segmentName widget name of the segment
# x y upper left corner of the segment
# width heigth width and height of the segment
#
#Results:
# none
proc DrawSegment {segmentName x y width height} {
global clock
toplevel $segmentName -borderwidth 2 -relief raised \
-background $clock(color) \
-highlightthickness 0 -takefocus 0
wm overrideredirect $segmentName 1
wm geometry $segmentName ${width}x${height}+${x}+${y}
if {[lindex [winfo server .] 0] == "Windows"} {
wm attributes $segmentName -topmost 1
}
bind $segmentName <1> {
if ![winfo ismapped .] {
wm deiconify .
# the following 2 lines are a workaround for disabling the apply
# button after the window is mapped the first time
# since the scale widget fires its command if it is mapped the
# first time and the apply button should be disabled if no config
# parameter has changed
# Note: This behavior is not a bug but the correct behavior of the
# scale widget.
update
.bb.apply config -state disabled
}
raise .
focus -force .
}
}
###########################################################################
# DrawDigit --
#
# draw a digit of the clock
#
#Arguments:
# rootname the rootname of the digit
# x y upper left corner of the digit
# what what should be drawn
# a number or a delimiter
#
#Results:
# none
proc DrawDigit {rootname x y what} {
global clock segmentData
if {[string length $what] == 1 &&
[string is integer -strict $what]} {
foreach seg $segmentData($what) {
foreach {xd yd wd ht} $segmentData($seg) break
set xd [expr {$x + $xd*$clock(segSize)}]
set yd [expr {$y + $yd*$clock(segSize)}]
set wd [expr {$wd*$clock(segSize)}]
set ht [expr {$ht*$clock(segSize)}]
DrawSegment $rootname$seg $xd $yd $wd $ht
}
} else {
foreach seg $segmentData(delim) {
foreach {xd yd wd ht} $segmentData($seg) break
set xd [expr {$x + $xd*$clock(segSize)}]
set yd [expr {$y + $yd*$clock(segSize)}]
set wd [expr {$wd*$clock(segSize)}]
set ht [expr {$ht*$clock(segSize)}]
DrawSegment $rootname$seg $xd $yd $wd $ht
}
}
}
###########################################################################
# DrawClock --
#
# draw the whole clock either at startup or
# after a reconfiguration
#
#Arguments:
# none
#
#Results:
# none
proc DrawClock {} {
global clock segmentData
# wait if a refresh is in progress
if $clock(draw) {
after 100 DrawClock
return
}
set clock(draw) 1
# destroy "old" clock
foreach dig {h1 h2 delim1 m1 m2 delim2 s1 s2} {
if {$dig == "delim1" || $dig == "delim2"} {
foreach seg $segmentData(delim) {
destroy .$dig$seg
}
} else {
foreach seg $segmentData(allSegs) {
destroy .$dig$seg
}
}
}
# draw clock with new configuration
if {$clock(style) == 12} {
foreach {H M S} [split [clock format [clock seconds] -format "%I.%M.%S"] .] break
} else {
foreach {H M S} [split [clock format [clock seconds] -format "%H.%M.%S"] .] break
}
set sx $clock(baseX)
set sy $clock(baseY)
foreach {h1 h2} [split $H {}] break
DrawDigit .h1 $sx $sy $h1
set clock(h1) $h1
incr sx [expr {$clock(digitWidth)+$clock(segSize)}]
DrawDigit .h2 $sx $sy $h2
set clock(h2) $h2
incr sx [expr {$clock(digitWidth)+$clock(segSize)}]
if $clock(showDelims) {
DrawDigit .delim1 $sx $sy delim1
}
incr sx [expr {2*$clock(segSize)}]
foreach {m1 m2} [split $M {}] break
DrawDigit .m1 $sx $sy $m1
set clock(m1) $m1
incr sx [expr {$clock(digitWidth)+$clock(segSize)}]
DrawDigit .m2 $sx $sy $m2
set clock(m2) $m2
if $clock(showSecs) {
incr sx [expr {$clock(digitWidth)+$clock(segSize)}]
if $clock(showDelims) {
DrawDigit .delim2 $sx $sy delim2
}
incr sx [expr {2*$clock(segSize)}]
foreach {s1 s2} [split $S {}] break
DrawDigit .s1 $sx $sy $s1
set clock(s1) $s1
incr sx [expr {$clock(digitWidth)+$clock(segSize)}]
DrawDigit .s2 $sx $sy $s2
set clock(s2) $s2
}
set clock(halfSec) 1
set clock(draw) 0
}
###########################################################################
# RefreshDigit --
#
# refresh a digit of the clock
#
#Arguments:
# rootname the rootname of the digit
# x y upper left corner of the digit
# oldVal current value of the digit
# newVal value which should be shown by the digit
#
#Results:
# none
proc RefreshDigit {rootname x y oldVal newVal} {
global clock segmentData
# determine which segments are not required for newVal
# and destroy these segments
foreach seg $segmentData($oldVal) {
if {[lsearch $segmentData($newVal) $seg] == -1} {
destroy $rootname$seg
}
}
# determine which segments must be shown aditional for newVal
# and create these segments
foreach seg $segmentData($newVal) {
if {[lsearch $segmentData($oldVal) $seg] == -1} {
foreach {xd yd wd ht} $segmentData($seg) break
set xd [expr {$x + $xd*$clock(segSize)}]
set yd [expr {$y + $yd*$clock(segSize)}]
set wd [expr {$wd*$clock(segSize)}]
set ht [expr {$ht*$clock(segSize)}]
DrawSegment $rootname$seg $xd $yd $wd $ht
}
}
}
###########################################################################
# RefreshClock --
#
# refresh the whole clock by doing the following things:
# - let the delimiters disappear after a half second
# - refresh the whole display after a full second
# both depending on the value of clock(halfSec)
#
#Arguments:
# none
#
#Results:
# none
proc RefreshClock {} {
global clock segmentData
# wait if a refresh is in progress
if $clock(draw) {
return
}
set clock(draw) 1
# let the delimiters disappear if clock(halfSec) is 1
if $clock(halfSec) {
if $clock(showDelims) {
foreach dig {delim1 delim2} {
foreach seg $segmentData(delim) {
destroy .$dig$seg
}
}
}
set clock(halfSec) 0
set clock(draw) 0
return
}
# refresh the clock if clock(halfSec) is 0
if {$clock(style) == 12} {
foreach {H M S} [split [clock format [clock seconds] -format "%I.%M.%S"] .] break
} else {
foreach {H M S} [split [clock format [clock seconds] -format "%H.%M.%S"] .] break
}
set sx $clock(baseX)
set sy $clock(baseY)
foreach {h1 h2} [split $H {}] break
if {$h1 != $clock(h1)} {
RefreshDigit .h1 $sx $sy $clock(h1) $h1
set clock(h1) $h1
}
incr sx [expr {$clock(digitWidth)+$clock(segSize)}]
if {$h2 != $clock(h2)} {
RefreshDigit .h2 $sx $sy $clock(h2) $h2
set clock(h2) $h2
}
incr sx [expr {$clock(digitWidth)+$clock(segSize)}]
if $clock(showDelims) {
DrawDigit .delim1 $sx $sy delim1
}
incr sx [expr {2*$clock(segSize)}]
foreach {m1 m2} [split $M {}] break
if {$m1 != $clock(m1)} {
RefreshDigit .m1 $sx $sy $clock(m1) $m1
set clock(m1) $m1
}
incr sx [expr {$clock(digitWidth)+$clock(segSize)}]
if {$m2 != $clock(m2)} {
RefreshDigit .m2 $sx $sy $clock(m2) $m2
set clock(m2) $m2
}
if $clock(showSecs) {
incr sx [expr {$clock(digitWidth)+$clock(segSize)}]
if $clock(showDelims) {
DrawDigit .delim2 $sx $sy delim2
}
incr sx [expr {2*$clock(segSize)}]
foreach {s1 s2} [split $S {}] break
if {$s1 != $clock(s1)} {
RefreshDigit .s1 $sx $sy $clock(s1) $s1
set clock(s1) $s1
}
incr sx [expr {$clock(digitWidth)+$clock(segSize)}]
if {$s2 != $clock(s2)} {
RefreshDigit .s2 $sx $sy $clock(s2) $s2
set clock(s2) $s2
}
}
set clock(halfSec) 1
set clock(draw) 0
}
###########################################################################
# ClockExit --
#
# show a user dialog and if the user selects yes then save the
# current configuration to a ressource file and exit the clock
#
#Arguments:
# none
#
#Results:
# none
proc ClockExit {} {
global rcFile config
if {[tk_messageBox -title "Digital Clock" -icon question -type yesno \
-message "Would you switch off the clock?"] == "yes"} {
set resfile [open $rcFile w]
puts $resfile [array get config]
close $resfile
exit
}
}
###########################################################################
# ConfigClock --
#
# configure the clock with the parameters from the resource file
# after startup or
# with the parameters given by the config dialog
#
#Arguments:
# none
#
#Results:
# none
proc ConfigClock {} {
global config clock
# transfer the config parameters
foreach elem [array names config] {
set clock($elem) $config($elem)
}
# calculate size for one digit
set clock(digitWidth) [expr {$config(digitWidth)*$clock(segSize)}]
set clock(digitHeight) [expr {$config(digitHeight)*$clock(segSize)}]
# calculate the size for the whole clock
set displayWidth \
[expr {$clock(digitWidth)+$clock(segSize)+$clock(digitWidth)}] ;# hour
incr displayWidth \
[expr {3*$clock(segSize)}] ;# + delimiter
incr displayWidth \
[expr {$clock(digitWidth)+$clock(segSize)+$clock(digitWidth)}] ;# + minutes
if $clock(showSecs) {
incr displayWidth \
[expr {3*$clock(segSize)}] ;# + delimiter
incr displayWidth \
[expr {$clock(digitWidth)+$clock(segSize)+$clock(digitWidth)}] ;# + seconds
}
set displayHeight $clock(digitHeight)
# calculate the clock position
set screenWidth [winfo screenwidth .]
set screenHeight [winfo screenheight .]
switch -- $clock(position) {
ULC {
set clock(baseX) 10
set clock(baseY) 10
}
URC {
set clock(baseX) [expr {$screenWidth-$displayWidth-10}]
set clock(baseY) 10
}
LLC {
set clock(baseX) 10
set clock(baseY) [expr {$screenHeight-$displayHeight-30}]
}
LRC {
set clock(baseX) [expr {$screenWidth-$displayWidth-10}]
set clock(baseY) [expr {$screenHeight-$displayHeight-30}]
}
}
# draw the clock
DrawClock
}
###########################################################################
# CreateConfigDialog --
#
# create a config dialog by using the main toplevel window
# Note:
# The right style for this dialog would be a transient toplevel
# but the usage of a transient window is not possible since it would
# be withdrawn if the main toplevel is withdrawn. And in my opinion
# there should be no additional window on the screen during the
# normal operation of the clock.
# It would be possible to use the
# wm attributes window -toolwindow 1
# but this works with MS Windows only.
#
#Arguments:
# none
#
#Results:
# none
proc CreateConfigDialog {} {
wm title . "clock configuration"
wm resizable . 0 0
wm protocol . WM_DELETE_WINDOW ClockExit
wm withdraw .
frame .top -bd 2 -relief raised
labelframe .top.style -text style -padx 2 -pady 2
frame .top.style.d
radiobutton .top.style.d.d12h -text "12h display" \
-variable config(style) -value 12 \
-command {.bb.apply config -state normal}
radiobutton .top.style.d.d24h -text "24h display" \
-variable config(style) -value 24 \
-command {.bb.apply config -state normal}
checkbutton .top.style.delim -text "show delimiters" \
-variable config(showDelims) \
-command {.bb.apply config -state normal}
checkbutton .top.style.ssecs -text "show seconds" \
-variable config(showSecs) \
-command {.bb.apply config -state normal}
frame .top.style.c -padx 2
label .top.style.c.ccol -relief raised -width 2 -bg $::config(color)
bind .top.style.c.ccol <1> {
set color [tk_chooseColor -title "Select a new digit color" \
-initialcolor $config(color)]
if {$color != ""} {
set config(color) $color
.top.style.c.ccol config -bg $config(color)
.bb.apply config -state normal
}
}
label .top.style.c.clbl -text "digit color"
bind .top.style.c.clbl <1> {
set color [tk_chooseColor -title "Select a new digit color" \
-initialcolor $config(color)]
if {$color != ""} {
set config(color) $color
.top.style.c.ccol config -bg $config(color)
.bb.apply config -state normal
}
}
frame .top.style.s
scale .top.style.s.sscl -orient horiz -from 2 -to 20 \
-variable config(segSize) \
-command {.bb.apply config -state normal;#}
label .top.style.s.slbl -text "clock size"
labelframe .top.place -text "clock position" -padx 2 -pady 2
radiobutton .top.place.ulc -text "upper left corner" \
-variable config(position) -value ULC \
-command {.bb.apply config -state normal}
radiobutton .top.place.urc -text "upper right corner" \
-variable config(position) -value URC \
-command {.bb.apply config -state normal}
radiobutton .top.place.llc -text "lower left corner" \
-variable config(position) -value LLC \
-command {.bb.apply config -state normal}
radiobutton .top.place.lrc -text "lower right corner" \
-variable config(position) -value LRC \
-command {.bb.apply config -state normal}
frame .bb
button .bb.ok -text OK -width 10 -command {
array set ::oldConfig [array get ::config]
ConfigClock
wm withdraw .
}
button .bb.cancel -text Cancel -width 10 -command {
array set ::config [array get ::oldConfig]
.top.style.c.ccol config -bg $::config(color)
.bb.apply configure -state disabled
wm withdraw .
}
button .bb.apply -text Apply -state disabled -width 10 -command {
array set ::oldConfig [array get ::config]
ConfigClock
.bb.apply configure -state disabled
}
pack .top.style.d.d12h .top.style.d.d24h -side left
pack .top.style.d -anchor w
pack .top.style.delim -anchor w
pack .top.style.ssecs -anchor w
pack .top.style.c.ccol .top.style.c.clbl -side left
pack .top.style.c -anchor w
pack .top.style.s.sscl .top.style.s.slbl -side left
pack .top.style.s -anchor w
grid .top.place.ulc .top.place.urc -sticky w
grid .top.place.llc .top.place.lrc -sticky w
pack .top.style .top.place -padx 2 -fill both
pack .top -padx 4 -pady 2 -fill x
pack .bb.apply .bb.cancel .bb.ok -side right -padx 4 -pady 2
pack .bb -pady 2 -anchor e
update idletasks
set screenWidth [winfo screenwidth .]
set screenHeight [winfo screenheight .]
set x [expr {([winfo screenwidth .]-[winfo reqwidth .])/2}]
set y [expr {([winfo screenheight .]-[winfo reqheight .])/2}]
wm geometry . +$x+$y
}
###########################################################################
# every --
#
# the well known every proc from Richard Suchenwirth
# it executes every given milliseconds delay a given script
#
#Arguments:
# ms the delay in milliseconds
# body the script to be executed
#
#Results:
# none
proc every {ms body} {eval $body; after $ms [info level 0]}
###########################################################################
# now lets start
CreateConfigDialog
ConfigClock
# save the current configuration to restore it if the user changes some
# parameters in the config dialog and after this he desides to cancel the
# configuration without making changes
array set oldConfig [array get config]
# refresh the clock display every half second
every 500 RefreshClockLV When I try the above clock, using Tcl/Tk 8.6, running on solaris 8 and displaying back to Windows XP, I notice a peculiar problem. When I select, on the config panel, the radio button for display in the lower right corner, then press Apply, the clock disappears and never returns - but the program keeps running. Does anyone else see this? Anyone have a suggestion for fixing it? Selecting any of the other 3 corner config options seems to work fine. [a bit later...] Never mind. I suspect I'm the only person in the world who will see this problem. See, my 2 monitor system is set up so that the monitors have different resolutions. That way, when I am having a hard time reading text on one screen, I drag the window to the other screen and automatically see it a bit larger. In the case of this application, however, the calculation for where the window should go puts it off the screen. I can hard code an override - no big deal...
HoMi-(2008-12-29) Since it was X-mas and I have thought that it would be a nice idea to make you a little X-mas present.
This is for all of you who prefer a 5x7 segment raster display for the digits rather than the well known 7 segment digit display. This clock looks very pretty with a "clock size" value lower than 8 (almost like a LED display).
To use this display style make the following two changes to the code above:
###########################################################################
# segment data
#
# coords for each segment of a digit
set j 0
set segmentData(allSegs) {}
foreach seg {a b c d e f g} {
for {set i 0} {$i <= 4} {incr i} {
set segmentData($seg$i) "$i $j 1 1"
lappend segmentData(allSegs) $seg$i
}
incr j
}
# coords for the delimiters
array set segmentData {
:1 {0 2 1 1}
:2 {0 4 1 1}
}
# required segments to show the whole digit
# digit {required segments}
array set segmentData {
0 {a1 a2 a3 b0 b4 c0 c4 d0 d4 e0 e4 f0 f4 g1 g2 g3}
1 {a2 b1 b2 c2 d2 e2 f2 g1 g2 g3}
2 {a1 a2 a3 b0 b4 c4 d3 e2 f1 g0 g1 g2 g3 g4}
3 {a0 a1 a2 a3 a4 b3 c2 d1 d2 d3 e4 f0 f4 g1 g2 g3}
4 {a0 a3 b0 b3 c0 c3 d0 d1 d2 d3 d4 e3 f3 g3}
5 {a0 a1 a2 a3 a4 b0 c0 d0 d1 d2 d3 e4 f0 f4 g1 g2 g3}
6 {a2 a3 b1 c0 d0 d1 d2 d3 e0 e4 f0 f4 g1 g2 g3}
7 {a0 a1 a2 a3 a4 b4 c3 d2 e1 f1 g1}
8 {a1 a2 a3 b0 b4 c0 c4 d1 d2 d3 e0 e4 f0 f4 g1 g2 g3}
9 {a1 a2 a3 b0 b4 c0 c4 d1 d2 d3 d4 e4 f3 g1 g2}
delim {:1 :2}
}Note, that you must delete the ressource file .clockrc, since it holds the old digit height, or edit that file and change the value after the word digitHeight from 9 to 7.
LV 2009 July 30 I tried running the script above (not the merry christmas variation, though) natively on a Windows XP system, using ActiveTcl 8.4.10. I happened to open the Windows Task Manager and was horrified to see a long list of tasks being spun off on the Windows system. There appears to be a task left running for each second. These appear in my task bar with the Tcl feature. Then there is another task being left around with the name delim1:1 with a Windows application icon. This doesn't seem like a good thing to do... If I bring up the config panel and click on the X, I am prompted asking if I want to shut off the clock, and then all the tasks disappear.
What are all these tasks that are showing up, and is it going to cause a problem if they just keep accumulating?
Thanks!
Interesting note - even if I run the clock on a remote SPARC Solaris system, and have it display back to my Windows XP desktop running cygwin/x, I still see all the tasks appear in the Windows Task Manager. That seems even more strange than seeing the tasks when running the script locally.