FullyTransparentDigitalClock2

HoMi-(2008-12-04) The story continuous:

First it was FullyTransparentDigitalClock by slebetman
Then it was FlickerFreeTransparentDigitalClock with some improvements by me
And now it is the

FullyTransparentDigitalClock2

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:

The clock is fully configurable in size, color and display style.
The clock it can be placed on the screen at the most common positions.
The clock uses a ressource file to hold the user defined configuration.

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 RefreshClock

Questions

LV 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:

Change the value config(digitHeight) from 9 to 7 within the configuration area
Replace the definition of the segment data with the following code fragment:

###########################################################################
# 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 resource 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.

HoMi-(2009-08-05) There exists a very simple explanation for your observation. Since the clock is made of toplevels each toplevel creates its own process in the process list. The process names in the list are the names of the toplevels without the trailing dot.
The clock ticks every half second to switch the delimiters on or off and updates the time every second too and therefore the content of the process list changes also every half second. As you can see this behaviour is absolutly normal.

Category Application

Category Date and Time