63 lines
2.0 KiB
Tcl
63 lines
2.0 KiB
Tcl
# 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
|