From: ian <ian>
Date: Sat, 26 Apr 2008 13:51:02 +0000 (+0000)
Subject: morse demonstrator
X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ijackson/git?a=commitdiff_plain;h=2cbcf164614a2bd3e74098f480e66f7448634766;p=trains.git

morse demonstrator
---

diff --git a/cebpic/morse-tester b/cebpic/morse-tester
new file mode 100755
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