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.<<br>>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 this 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 cklick 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?
----
!!!!!!
%| [Category Application] | [Category Date and Time] |%
!!!!!!