Morse en/decoder: works both ways ASCII <-> Morse
proc morse {s} {
# \u00C4 - Ä (Auml)
# \u00D6 - Ö (Ouml)
# \u00DC - Ü (Uuml)
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 ____.
. ._._._ , __..__ ? ..__.. / _.._. ( _.__. ) _.__._
+ ._._. : ___... ; ...___ - _...._ = _..._
~ ._... # ..._._ $ _..._._
}
set res ""
if [regexp {^[._ ]+$} $s] {
regsub -all { +} $s " B " s
foreach i [split $s] {
if {$i==""} continue
if {$i=="B"} {append res " "; continue}
set ix [lsearch $_morse $i]
if {$ix>=0} {
append res [lindex $_morse [expr {$ix-1}]]
} else {append res ?}
}
} else {
foreach i [split [string toupper $s] ""] {
if {$i==" "} {append res " "; continue}
set ix [lsearch -exact $_morse $i]
if {$ix>=0 && $ix%2==0} {
append res "[lindex $_morse [expr {$ix+1}]] "
}
}
}
set res
} ;#RS - slightly uncrufted 2001-12-04KBK (2002-04-09)
QST QST QST DE KE9TV/2 KE9TV/2 KE9TV/2 BT
added punctuation, plus added procedural signs
~ - Stand by (AS) # - End of work (SK or VA) $ - Break (BK)
Procedural signs AR, BT and KN are encoded by +, = and ( respectively, since those are the meaning of those signs within a message body.
Ampersand should be sent as the two characters ES.
Still to do: AAA is a period, but a decimal point is sent as a character R.
VY 73 DE KE9TV/2 SK AR
For practizing, see also A little Morse trainer
DKF: Here's a morse code player I wrote for Rosetta Code that uses Snack to do the playing:
# This uses the GUI-free part of the Snack library
package require sound
# A simple pause while running the event loop, in terms of basic time units
proc pause n {
global t
after [expr {$t * $n}] set ok 1
vwait ok
}
# Generate using a sine-wave filter
proc beep n {
global frequency
set f [snack::filter generator $frequency 30000 0.0 sine -1]
set s [snack::sound -rate 22050]
$s play -filter $f
pause $n
$s stop
$s destroy
$f destroy
pause 1
}
# The dits and the dahs are just beeps of different lengths
interp alias {} dit {} beep 1
interp alias {} dah {} beep 3
set MORSE_CODE {
"!" "---." "\"" ".-..-." "$" "...-..-" "'" ".----."
"(" "-.--." ")" "-.--.-" "+" ".-.-." "," "--..--"
"-" "-....-" "." ".-.-.-" "/" "-..-."
":" "---..." ";" "-.-.-." "=" "-...-" "?" "..--.."
"@" ".--.-." "[" "-.--." "]" "-.--.-" "_" "..--.-"
"0" "-----" "1" ".----" "2" "..---" "3" "...--"
"4" "....-" "5" "....." "6" "-...." "7" "--..."
"8" "---.." "9" "----."
"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" "--.."
}
# The code to translate text to morse code and play it
proc morse {str wpm} {
global t MORSE_CODE
set t [expr {1200 / $wpm}]
# Backslash and space are special cases in various ways
set map {"\\" {} " " {[pause 4]}}
# Append each item in the code to the map, with an inter-letter pause after
foreach {from to} $MORSE_CODE {lappend map $from "$to\[pause 3\]"}
# Convert to dots and dashes
set s [string map $map [string toupper $str]]
# Play the dots and dashes by substituting commands for them
subst [string map {"." [dit] "-" [dah]} $s]
return
}
# We'll play at a fairly high pitch
set frequency 700
morse "Morse code with Tcl and Snack." 20