[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 .-.- �������� -... 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 / " " } 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} ---- [Arts and crafts of Tcl-Tk programming]