[http://mini.net/files/Morser.jpg] ---- [Richard Suchenwirth] 2002-08-25 - This weekend fun project makes the computer understand [Morse code] entered on the left mouse button, when over the "brass" knob at top left. Below, you can adjust some timing thresholds, and see the decoded dah-dit pattern and the resulting text on a sort of "ticker tape". Clear the output with the "C" button. The "?" button opens a help field with the complete alphabet, or closes it again if you know it by heart. package require Tk array set morse { .- A .-.- \u00C4 -... B -.-. C -.. D . E ..-. F --. G .... H .. I .--- J -.- K .-.. L -- M -. N --- O ---. \u00D6 .--. P --.- Q .-. R ... S - T ..- U ..-- \u00DC ...- V .-- W -..- X -.-- Y --.. Z ----- 0 .---- 1 ..--- 2 ...-- 3 ....- 4 ..... 5 -.... 6 --... 7 ---.. 8 ----. 9 / " " } option add *Button -padx 0 proc ui {} { global timevec morse set font {Courier 10} canvas .c -height 58 -relief sunken -borderwidth 1 .c create oval 5 5 55 55 -fill gold2 -outline gold3 -width 2 -tag key .c create text 70 2 -text "Morse Trainer" -anchor nw \ -font {Times 24 {bold italic}} .c create text 70 38 -anchor nw -text \ "Click the brass button to morse - have fun with Tcl/Tk!" .c bind key <1> {compute; %W move current 2 2} .c bind key {compute; %W move current -2 -2} grid .c - -sticky news frame .f label .f.lon -text On: entry .f.on -textvar ::th_on -width 4 label .f.loff -text Off: entry .f.off -textvar ::th_off -width 4 label .f.lgap -text Gap: entry .f.gap -textvar ::th_gap -width 4 eval pack [winfo children .f] -side left grid .f - button .clear -text C -command init label .info1 -textvar ::info1 -width 40 -font $font \ -anchor e grid .clear .info1 -sticky news button .help -text ? -command {help .help} label .info2 -textvar ::info2 -bg white -width 40 -anchor e -font $font grid .help .info2 -sticky news label .h -textvar ::help -font $font -relief sunken -bg lightyellow set tmp {} foreach {mors char} [array get morse] { lappend tmp [list $char $mors] } foreach {1 2 3 4 5} [lsort $tmp] { foreach i {1 2 3 4 5} { append ::help "[set $i]\t" } append ::help \n } grid columnconfigure . 1 -weight 1 init } proc help {w} { if {[$w cget -text]=="?"} { grid .h - -sticky news $w config -text ! } else { grid forget .h $w config -text ? } } proc init {} { set ::info1 {}; set ::info2 {}; set ::timevec {}; set ::t 0 set ::th_on 200 set ::th_off 200 set ::th_gap 9 } # Times for an on/off signal are measured here, and appended to timevec proc compute {} { global t timevec global th_on th_off th_gap set now [clock clicks -milliseconds] if {$t} {lappend timevec [expr {$now - $t}]} set t $now set res "" foreach {on off} $timevec { if {$on>$th_on} { append res - } else { append res . } if {$off > $th_off} {append res " "} if {$off > $th_off * $th_gap} {append res "/ "} } set ::info1 $res set ::info2 [morsedecode $res] } # This maps "..." to "s", etc. proc morsedecode string { global morse set res "" foreach part $string { if {[info exists morse($part)]} { append res $morse($part) } else {append res "?"} } set res } ui bind . {exec wish $argv0 &; exit} ---- Using the [Snack] sound toolkit, you can make the morse trainer beep (in traditional morse code style) while the mouse is held down over the "knob". Just append this to the code: package require snack set cs [snack::sound -rate 22050] set playing 0 set filter [snack::filter generator 1000 30000 0.0 sine] rename compute _compute proc compute {} { global cs playing filter if {$playing} { $cs stop } else { $cs play -filter $filter } set playing [expr {!$playing}] _compute } ;# FW ---- [Arts and crafts of Tcl-Tk programming]