morse demonstrator

diff --git a/cebpic/morse-tester b/cebpic/morse-tester
new file mode 100755 (executable)
index 0000000..f92a2f7
--- /dev/null
+++ b/cebpic/morse-tester
@@ -0,0 +1,141 @@
+#!/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