#!/usr/bin/wish
#
# usage:
#  type these things in the window
#    a-z 0-9    add character to queue or to repeat string
#    spc        insert morse space
#    #          clear, make us repeat
#    =          clear, do not repeat

proc widgets {} {
    catch { destroy .b }
    frame .b -width 20 -height 20
    pack .b -padx 70 -pady 20 -fill none
    . configure -background {#222}
}

proc lamp-off {} { .b configure -background black }
proc lamp-on {} { .b configure -background red }

proc bgerror {emsg} {
    global errorCode errorInfo
    puts stderr \
"==========BGERROR==========
$emsg
$errorCode
$errorInfo
===========================
"
}

proc setup {} {
    global morselist
    widgets
    lamp-off
    foreach {key value} $morselist {
	bind . [string tolower $key] [list morse-key $key $value]
    }
    bind . {#} { repeat 1 }
    bind . = { repeat 0 }
    bind . <Key-space> { morse-add " " | }
    fconfigure stdout -buffering none
}

proc repeat {yn} {
    global repeating morse_after morse_queue morse_repeat
    lamp-off
    set morse_queue {}
    set morse_repeat {}
    set repeating $yn
    if {[info exists morse_after]} {
	after cancel $morse_after
	unset morse_after
    }
    puts ""
}

proc reload {} {
    uplevel #0 source morse-tester
}

proc morse-add {key dotsdashes} {
    global repeating morse_queue morse_repeat morse_after
    append morse_queue $dotsdashes
    if {$repeating} { append morse_repeat $dotsdashes }
    if {![info exists morse_after]} morse-next
    puts -nonewline $key
}

proc morse-key {key dotsdashes} {
    morse-add $key "$dotsdashes "
}

set morse_queue {}
set unit_ms 66
set repeating 1

proc after-units {units script} {
    global unit_ms morse_after
    set morse_after [after [expr {$units * $unit_ms}] $script]
}

proc space {units} {
    lamp-off; after-units $units morse-next
}

proc morse-next {} {
    global morse_queue morse_repeat morse_after
    if {![string length $morse_queue]} {
	if {![string length $morse_repeat]} { unset morse_after; return }
	set morse_queue "|$morse_repeat"
    }
    set c [string index $morse_queue 0]
    set morse_queue [string range $morse_queue 1 end]
    switch -exact -- $c {
	. { lamp-on; after-units 1 {space 1} }
	_ { lamp-on; after-units 3 {space 1} }
	{ } { space 2 }
	| { space 6 }
    }
}

set morselist {
A	._
B	_...
C	_._.
D	_..
E	.
F	.._.
G	__.
H	....
I	..
J	.___
K	_._
L	._..
M	__
N	_.
O	___
P	.__.
Q	__._
R	._.
S	...
T	_
U	.._
V	..._
W	.__
X	_.._
Y	_.__
Z	__..
0	_____
1	.____
2	..___
3	...__
4	...._
5	.....
6	_....
7	__...
8	___..
9	____.
}

setup