RosettaCodeData/Task/Morse-code/PicoLisp/morse-code.l

44 lines
1.7 KiB
Plaintext

# *Morse *Dit *Dah
(balance '*Morse
(mapcar
'((L)
(def (car L)
(mapcar = (chop (cadr L)) '("." .)) ) )
(quote
("!" "---.") ("\"" ".-..-.") ("$" "...-..-") ("'" ".----.")
("(" "-.--.") (")" "-.--.-") ("+" ".-.-.") ("," "--..--")
("-" "-....-") ("." ".-.-.-") ("/" "-..-.")
("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" "--..")
("[" "-.--.") ("]" "-.--.-") ("_" "..--.-") ) ) )
# Words per minute
(de wpm (N)
(setq *Dit (*/ 1200 N) *Dah (* 3 *Dit)) )
(wpm 20)
# Morse a string
(de morse (Str)
(for C (chop Str)
(cond
((sp? C) (wait (+ *Dah *Dit))) # White space: Pause
((idx '*Morse (uppc C)) # Known character
(for Flg (val (car @))
(call "/usr/bin/beep" "-D" *Dit "-l" (if Flg *Dit *Dah)) ) )
(T (call "/usr/bin/beep" "-f" 370)) ) # Unkown character
(wait (- *Dah *Dit)) ) )
(morse "Hello world!")