package require Tk

namespace eval ::clock::sevenSegmentDisplay {
    variable off grey15
    variable on red

    proc ::clock::sevenSegmentDisplay::main {} {
        pack [canvas .c -background black]
        drawClock
        wm geometry . 210x60+[expr [lindex [wm maxsize .] 0]-210]+0
        wm overrideredirect . 1
        bind . <Double-Button-1> exit
        updateClock
    }

    proc ::clock::sevenSegmentDisplay::updateClock {} {
        variable on
        variable off
        .c itemconfigure seg -fill $off
        set time [clock format [clock seconds] -format "%H%M%S"]
        foreach digit [split $time {}] tag {h1 h2 m1 m2 s1 s2} {
            foreach seg [digit2segments $digit] {
                .c itemconfigure [format "%s%s" $tag $seg] -fill $on
            }
        }
        after 1000 ::clock::sevenSegmentDisplay::updateClock
    }

    proc ::clock::sevenSegmentDisplay::drawClock {} {
        variable on
        variable off
        set y 10
        foreach digit {h1 h2 : m1 m2 : s1 s2} x {10 40 70 80 110 140 150 180} {
            if { [string match $digit :] } {
                .c create oval [expr {$x-3}] [expr {$y+7}] [expr {$x+3}] [expr {$y+13}] \
                    -fill $on -tags $digit
                .c create oval [expr {$x-3}] [expr {$y+27}] [expr {$x+3}] [expr {$y+33}] \
                    -fill $on -tags $digit
                continue
            }
            # Segment 1
            .c create line [expr {$x+2}] $y [expr {$x+18}] $y \
                -caps round -width 3 -fill $off -tags [list seg ${digit}1]
            # Segment 2
            .c create line [expr {$x+20}] [expr {$y+2}] [expr {$x+20}] [expr {$y+18}] \
                -caps round -width 3 -fill $off -tags [list seg ${digit}2]
            # Segment 3
            .c create line [expr {$x+20}] [expr {$y+22}] [expr {$x+20}] [expr {$y+38}] \
                -caps round -width 3 -fill $off -tags [list seg ${digit}3]
            # Segment 4
            .c create line [expr {$x+2}] [expr {$y+40}] [expr {$x+18}] [expr {$y+40}] \
                -caps round -width 3 -fill $off -tags [list seg ${digit}4]
            # Segment 5
            .c create line $x [expr {$y+22}] $x [expr {$y+38}] \
                -caps round -width 3 -fill $off -tags [list seg ${digit}5]
            # Segment 6
            .c create line $x [expr {$y+2}] $x [expr {$y+18}] \
                -caps round -width 3 -fill $off -tags [list seg ${digit}6]
            # Segment 7
            .c create line [expr {$x+2}] [expr {$y+20}] [expr {$x+18}] [expr {$y+20}] \
                -caps round -width 3 -fill $off -tags [list seg ${digit}7]
        }
    }
    
    proc ::clock::sevenSegmentDisplay::digit2segments { digit } {
        #   1    ---
        #  6 2   | |
        #   7    ---
        #  5 3   | |
        #   4    --- 
        switch $digit {
            0 {return {1 2 3 4 5 6}}
            1 {return {2 3}}
            2 {return {1 2 4 5 7}}
            3 {return {1 2 3 4 7}}
            4 {return {2 3 6 7}}
            5 {return {1 3 4 6 7}}
            6 {return {1 3 4 5 6 7}}
            7 {return {1 2 3}}
            8 {return {1 2 3 4 5 6 7}}
            9 {return {1 2 3 4 6 7}}
            default {return -code error "error: \"$digit\" is not a digit"}
        }
    }
}

::clock::sevenSegmentDisplay::main