package require Tk

# Here's the original color scheme
array set S {
    foreground gray50 background black font "Ariel 20 bold"
    onforeground red onbackground black onfont "Ariel 20 bold"}
# Here's a more vivid color scheme
array set S {
    foreground gray50 background black
    onforeground black onbackground magenta}

proc DoDisplay {} {
    wm title . "Word Clock by Keith Vetter"
    text .t -wrap word -width 70 -height 19 -font "Ariel 20 bold" \
        -bg $::S(background)
    pack .t -fill both -expand 1

    foreach who {h s} {
        foreach item $::all($who) {
            set tag $who,[string map {" " ""} $item]
            .t tag configure $tag -foreground gray50 -font $::S(font)
            .t insert end $item $tag
            .t insert end " "
        }
    }
    set ::on {}
}
proc ShowTime {h m s} {
    foreach tag $::on {
        .t tag configure $tag -foreground $::S(foreground) \
        -background $::S(background) -font $::S(font)
    }
    set ::on {}

    set english [Time2English $h $m $s]
    set preTag h
    foreach item $english {
        if {$item eq "and" || $item eq "exactly"} { set preTag "s" }
        set tag $preTag,[string map {" " ""} $item]
        .t tag configure $tag -foreground $::S(onforeground) \
            -background $::S(onbackground) -font $::S(onfont)
        lappend ::on $tag
    }
}
proc Ticker {} {
    foreach aid [after info] { after cancel $aid }
    set a [clock format [clock seconds] -format "%l %M %S"]
    scan $a "%d %d %d" h m s
    ShowTime $h $m $s
    after 1000 Ticker
}

# Display text broken into a hour/minute part and a seconds part
set all(h) {"Five past" "Ten past" "Quarter past" "Twenty past"
    "Twenty-five past"
    "Half past" "Twenty-five to" "Twenty to" "Quarter to" "Ten to" "Five to"
    One one Two two Three three Four four Five five Six six Seven seven
    Eight eight Nine nine Ten ten Eleven Twelve "o'clock"
    oh-one oh-two oh-three oh-four oh-five oh-six oh-seven oh-eight oh-nine
    eleven twelve
    thirteen fourteen sixteen seventeen eighteen nineteen
    twenty-one twenty-two twenty-three twenty-four
    twenty-six twenty-seven twenty-eight twenty-nine
    thirty-one thirty-two thirty-three thirty-four
    thirty-six thirty-seven thirty-eight thirty-nine
    forty-one forty-two forty-three forty-four
    forty-six forty-seven forty-eight forty-nine
    fifty-one fifty-two fifty-three fifty-four
    fifty-six fifty-seven fifty-eight fifty-nine}
set all(s) {and exactly "one second" two three four five six seven eight nine ten
    eleven twelve thirteen fourteen fifteen sixteen seventeen eighteen nineteen
    twenty twenty-one twenty-two twenty-three twenty-four twenty-five
    twenty-six twenty-seven twenty-eight twenty-nine
    thirty thirty-one thirty-two thirty-three thirty-four thirty-five
    thirty-six thirty-seven thirty-eight thirty-nine
    forty forty-one forty-two forty-three forty-four forty-five
    forty-six forty-seven forty-eight forty-nine
    fifty fifty-one fifty-two fifty-three fifty-four fifty-five
    fifty-six fifty-seven fifty-eight fifty-nine seconds
}

array set PAST {5 "five past" 10 "ten past" 15 "quarter past"
    20 "twenty past" 25 "twenty-five past" 30 "half past"}
array set TO {35 "twenty-five to" 40 "twenty to" 45 "quarter to"
    50 "ten to" 55 "five to"
}
set WordNumbers {- one two three four five six seven eight nine ten eleven
    twelve thirteen fourteen fifteen sixteen seventeen eighteen nineteen
    twenty twenty-one twenty-two twenty-three twenty-four twenty-five
    twenty-six twenty-seven twenty-eight twenty-nine
    thirty thirty-one thirty-two thirty-three thirty-four thirty-five
    thirty-six thirty-seven thirty-eight thirty-nine
    forty forty-one forty-two forty-three forty-four forty-five
    forty-six forty-seven forty-eight forty-nine
    fifty fifty-one fifty-two fifty-three fifty-four fifty-five
    fifty-six fifty-seven fifty-eight fifty-nine
}

proc Time2English {hour minute second} {
    set english {}
    if {$minute == 0} {
        set english [list [lindex $::WordNumbers $hour] "o'clock"]
    } elseif {[info exists ::PAST($minute)]} {
        lappend english $::PAST($minute)
        lappend english [lindex $::WordNumbers $hour]
    } elseif {[info exists ::TO($minute)]} {
        lappend english $::TO($minute)
        incr hour
        if {$hour == 13} {set hour 1}
        lappend english [lindex $::WordNumbers $hour]
    } elseif {$minute < 10} {
        lappend english [lindex $::WordNumbers $hour]
        lappend english "oh-[lindex $::WordNumbers $minute]"
    } else {
        lappend english [lindex $::WordNumbers $hour]
        lappend english [lindex $::WordNumbers $minute]
    }

    if {$second == 0} {
        lappend english "exactly"
    } elseif {$second == 1} {
        lappend english "and" "one second"
    } else {
        lappend english "and" [lindex $::WordNumbers $second] "seconds"
    }
    lset english 0 [string totitle [lindex $english 0]]
    return $english
}

DoDisplay
Ticker
return