string <-> morse code

morse.lisp

;;;; Last modified : 2013-05-31 18:03:49 tkych

;; Usage:
;;   (string-to-morse "Samuel")
;;         => "... ._ __ .._ . ._.."
;;   (morse-to-string "__ ___ ._. ... .")
;;         => "MORSE"

;;   (string-to-morse "Samuel Morse")
;;         => error!! #\Space can't be converted into morse code.
;;   (morse-to-string "????")
;;         => error!! "????" can't be converted to character.

;; Reference:
;;   Marco Baringer's slime tutorial,
;;     http://common-lisp.net/project/movies/movies/slime.mov
;;   Morse code,
;;     http://morsecode.scphillips.com/morse2.html
;;     http://en.wikipedia.org/wiki/Morse_code


;;=====================================================================
;; Morse
;;=====================================================================
(in-package :cl-user)

(eval-when (:compile-toplevel :load-toplevel :execute)
  (ql:quickload '(:cl-ppcre :anaphora)))

(defpackage :morse
  (:use :cl)
  (:import-from :anaphora :aif :it)
  (:export :string-to-morse :morse-to-string))

(in-package :morse)


;;---------------------------------------------------------------------
(defparameter *morse-code-alist*
  '(;; Letters
    (#\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 . "__..")

    ;; Digits
    (#\0 . "_____")
    (#\1 . ".____")
    (#\2 . "..___")
    (#\3 . "...__")
    (#\4 . "...._")
    (#\5 . ".....")
    (#\6 . "_....")
    (#\7 . "__...")
    (#\8 . "___..")
    (#\9 . "____.")

    ;; Punctuation Marks
    (#\. . "._._._")     ;Full_stop, Period [.]
    (#\, . "__..__")     ;Comma [,]
    (#\? . "..__..")     ;Question mark, Query [?]
    (#\' . ".____.")     ;Apostrophe [']
    (#\! . "_._.__")     ;Excamation mark [!]
    (#\/ . "_.._.")      ;Slash, Fraction bar [/]
    (#\( . "_.__.")      ;Brackets (Parentheses) open [(]
    (#\) . "_.__._")     ;Brackets (Parentheses) closed [)]
    (#\& . "._...")      ;Ampersand, Wait [&]
    (#\: . "___...")     ;Colon [:]
    (#\; . "_._._.")     ;Semicolon [;]
    (#\= . "_..._")      ;Double dash, Equals sign [=]
    (#\+ . "._._.")      ;Plus [+]
    (#\- . "_...._")     ;Hyphen, Minus [-]
    (#\_ . "..__._")     ;Underscore [_]
    (#\" . "._.._.")     ;Quotation mark ["]
    (#\$ . "_..._")      ;Dollar Sign [$]
    (#\@ . ".__._.")     ;At sign [@]
    ))

;; TODO: add morse code
;;   Prosign	Morse
;;   AA, New line "._._"
;;   AR, End of message "._._."
;;   AS, Wait "._..."
;;   BK, Break "_..._._"
;;   BT, New paragraph "_..._"
;;   CL, Going off the air ("clear") "_._.._.."
;;   CT, Start copying "_._._"
;;   DO, Change to wabun code "_..___"
;;   KN, Invite a specific station to transmit "_.__."
;;   SK, End of transmission (also VA) "..._._"
;;   SN, Understood (also VE) "..._."
;;   SOS, Distress message "...___..."


;;---------------------------------------------------------------------
(defun char-to-morse (char)
  (aif (assoc char *morse-code-alist* :test #'char-equal)
       (cdr it)
       (error "~S can't be converted to morse code." char)))

(defun morse-to-char (morse)
  (aif (rassoc morse *morse-code-alist* :test #'string=)
       (car it)
       (error "~S can't be converted to character." morse)))

(defun string-to-morse (str)
  (format nil "~{~A~^ ~}" (map 'list #'char-to-morse str)))

(defun morse-to-string (morse)
  (map 'string #'morse-to-char (ppcre:split " " morse)))


;;---------------------------------------------------------------------
;; Test
;;---------------------------------------------------------------------
(defun test ()
  (assert (char-equal (morse-to-char "_.._")
                      #\X))
  (assert (handler-case (morse-to-char "?")
          (simple-error () t)))
  
  (assert (string-equal (char-to-morse #\x)
                        "_.._"))
  (assert (handler-case (char-to-morse #\space)
          (simple-error () t)))
  
  (assert (string-equal (morse-to-string "")
                        ""))
  (assert (string-equal (morse-to-string "__ ___ ._. ... .")
                        "Morse"))
  (assert (handler-case (morse-to-string "??????????")
          (simple-error () t)))
  
  (assert (string-equal (string-to-morse "")
                        ""))
  (assert (string-equal (string-to-morse "MORSE")
                        "__ ___ ._. ... ."))
  (assert (handler-case (string-to-morse "ok go")
          (simple-error () t)))
  
  t)


;;=====================================================================