# *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!")