2004-08-02 VI : If you're blind without lenses like me. Or if you're old fashioned, unlike me, you might like this quaint digital display. uses minimalist curses and displays a large digital clock (white on black) in a terminal window.
2004-10-12 VI : Changed to support changes in minimalist curses. No more getch and timeout
#!/usr/local/tcl/8.4.5/bin/tclsh8.4
set fontmap {
7C CE DE F6 E6 C6 7C 00 30 70 30 30 30 30 FC 00 78 CC 0C 38 60 CC FC
00 78 CC 0C 38 0C CC 78 00 1C 3C 6C CC FE 0C 1E 00 FC C0 F8 0C 0C CC
78 00 38 60 C0 F8 CC CC 78 00 FC CC 0C 18 30 30 30 00 78 CC CC 78 CC
CC 78 00 78 CC CC 7C 0C 18 70 00 00 18 18 00 00 18 18 00 00 18 18 00
00 18 18 30 18 30 60 C0 60 30 18 00 00 00 7E 00 7E 00 00 00 60 30 18
0C 18 30 60 00 3C 66 0C 18 18 00 18 00
}
package require curses
proc bigstr {str row col} {
curses attr off reverse
set reverse 0
set charno 0
foreach char [split $str {}] {
binary scan $char c f
set index [expr ($f - 0x30) * 8]
for {set line 0} {$line < 8} {incr line} {
set bitline 0x[lindex $::fontmap [expr $index + $line]]
binary scan [binary format c $bitline] B8 charline
set cix 0
foreach c [split $charline {}] {
if {$c} {
curses attr on reverse
curses move [expr $row + $line] [expr $col + $charno * 8 + $cix]
curses puts " "
}
incr cix
}
}
incr charno
}
}
proc display {} {
curses erase
bigstr [clock format [clock seconds] -format %H:%M:%S] 10 5
curses move 0 0
curses refresh
after 1000 display
}
proc dclock {} {
fconfigure stdin -buffering none -blocking 0
fileevent stdin readable {set ::forever 1}
curses refresh; # empty the screen before we start
display
vwait ::forever
read stdin; # clear out input queue before exit
}
dclock