aparler/RosettaCodeData
1
0
Fork 0
Code Issues 12 Pull requests 3 Projects Releases Packages Wiki Activity Actions

A-M baby

Browse source
This commit is contained in:
Ingy döt Net 2013-04-10 21:29:02 -07:00
parent 764da6cbbb
commit db842d013d
19005 changed files with 197040 additions and 7 deletions
Download patch file Download diff file Expand all files Collapse all files

43
Task/Morse-code/PicoLisp/morse-code.l Normal file
View file

@ -0,0 +1,43 @@
# *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!")