curses digital clock

VI 2004-08-02: 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

---

digital 7 segment display clock