StumpWM utilities for Morse code encoding/decoding

morse.lisp

;; -*- lisp -*-
;; Morse code decoder
(defparameter *morse-code-decoder* (make-hash-table :test #'equal))

(setf (gethash ".-" *morse-code-decoder*) "a")
(setf (gethash "-..." *morse-code-decoder*) "b")
(setf (gethash "-.-." *morse-code-decoder*) "c")
(setf (gethash "-.." *morse-code-decoder*) "d")
(setf (gethash "." *morse-code-decoder*) "e")
(setf (gethash "..-." *morse-code-decoder*) "f")
(setf (gethash "--." *morse-code-decoder*) "g")
(setf (gethash "...." *morse-code-decoder*) "h")
(setf (gethash ".." *morse-code-decoder*) "i")
(setf (gethash ".---" *morse-code-decoder*) "j")
(setf (gethash ".-" *morse-code-decoder*) "k")
(setf (gethash ".-.." *morse-code-decoder*) "l")
(setf (gethash "--" *morse-code-decoder*) "m")
(setf (gethash "-." *morse-code-decoder*) "n")
(setf (gethash "---" *morse-code-decoder*) "o")
(setf (gethash ".--." *morse-code-decoder*) "p")
(setf (gethash "--.-" *morse-code-decoder*) "q")
(setf (gethash ".-." *morse-code-decoder*) "r")
(setf (gethash "..." *morse-code-decoder*) "s")
(setf (gethash "-" *morse-code-decoder*) "t")
(setf (gethash "..-" *morse-code-decoder*) "u")
(setf (gethash "...-" *morse-code-decoder*) "v")
(setf (gethash ".--" *morse-code-decoder*) "w")
(setf (gethash "-..-" *morse-code-decoder*) "x")
(setf (gethash "-.--" *morse-code-decoder*) "y")
(setf (gethash "--.." *morse-code-decoder*) "z")
(setf (gethash "-----" *morse-code-decoder*) "0")
(setf (gethash ".----" *morse-code-decoder*) "1")
(setf (gethash "..---" *morse-code-decoder*) "2")
(setf (gethash "...--" *morse-code-decoder*) "3")
(setf (gethash "....-" *morse-code-decoder*) "4")
(setf (gethash "....." *morse-code-decoder*) "5")
(setf (gethash "-...." *morse-code-decoder*) "6")
(setf (gethash "--..." *morse-code-decoder*) "7")
(setf (gethash "---.." *morse-code-decoder*) "8")
(setf (gethash "----." *morse-code-decoder*) "9")
(setf (gethash ".-.-.-" *morse-code-decoder*) ".")
(setf (gethash "--..--" *morse-code-decoder*) ",")
(setf (gethash "..--.." *morse-code-decoder*) "?")
(setf (gethash ".----." *morse-code-decoder*) "'")
(setf (gethash "-.-.--" *morse-code-decoder*) "!")
(setf (gethash "-..-." *morse-code-decoder*) "/")
(setf (gethash "-.--." *morse-code-decoder*) "(")
(setf (gethash "-.--.-" *morse-code-decoder*) ")")
(setf (gethash ".-..." *morse-code-decoder*) "&")
(setf (gethash "---..." *morse-code-decoder*) ":")
(setf (gethash ".-.-." *morse-code-decoder*) ";")
(setf (gethash "-...-" *morse-code-decoder*) "=")
(setf (gethash ".-.-." *morse-code-decoder*) "+")
(setf (gethash "-....-" *morse-code-decoder*) "-")
(setf (gethash ".--.-" *morse-code-decoder*) "_")
(setf (gethash ".-..-." *morse-code-decoder*) "\"")
(setf (gethash "..-..-" *morse-code-decoder*) "$")
(setf (gethash ".--.-." *morse-code-decoder*) "@")

(defun %decode-morse ()
  (let* ((phrase (read-one-line (current-screen) "Text to decode: "
				:initial-input (get-x-selection))))
    (when phrase
      (loop
	 for code in (split-string phrase '(#\space #\tab #\newline))
	 collect (gethash code *morse-code-decoder* code) into parts
	 finally (message "Decoded: ~a" (apply #'concat parts))))))

(defcommand decode-morse () ()
  (%decode-morse))

;; Morse code encoder
(defparameter *morse-code-encoder* (make-hash-table :test #'equal))

(setf (gethash #\a *morse-code-encoder*) ".-")
(setf (gethash #\b *morse-code-encoder*) "-...")
(setf (gethash #\c *morse-code-encoder*) "-.-.")
(setf (gethash #\d *morse-code-encoder*) "-..")
(setf (gethash #\e *morse-code-encoder*) ".")
(setf (gethash #\f *morse-code-encoder*) "..-.")
(setf (gethash #\g *morse-code-encoder*) "--.")
(setf (gethash #\h *morse-code-encoder*) "....")
(setf (gethash #\i *morse-code-encoder*) "..")
(setf (gethash #\j *morse-code-encoder*) ".---")
(setf (gethash #\k *morse-code-encoder*) ".-")
(setf (gethash #\l *morse-code-encoder*) ".-..")
(setf (gethash #\m *morse-code-encoder*) "--")
(setf (gethash #\n *morse-code-encoder*) "-.")
(setf (gethash #\o *morse-code-encoder*) "---")
(setf (gethash #\p *morse-code-encoder*) ".--.")
(setf (gethash #\q *morse-code-encoder*) "--.-")
(setf (gethash #\r *morse-code-encoder*) ".-.")
(setf (gethash #\s *morse-code-encoder*) "...")
(setf (gethash #\t *morse-code-encoder*) "-")
(setf (gethash #\u *morse-code-encoder*) "..-")
(setf (gethash #\v *morse-code-encoder*) "...-")
(setf (gethash #\w *morse-code-encoder*) ".--")
(setf (gethash #\x *morse-code-encoder*) "-..-")
(setf (gethash #\y *morse-code-encoder*) "-.--")
(setf (gethash #\z *morse-code-encoder*) "--..")
(setf (gethash #\0 *morse-code-encoder*) "-----")
(setf (gethash #\1 *morse-code-encoder*) ".----")
(setf (gethash #\2 *morse-code-encoder*) "..---")
(setf (gethash #\3 *morse-code-encoder*) "...--")
(setf (gethash #\4 *morse-code-encoder*) "....-")
(setf (gethash #\5 *morse-code-encoder*) ".....")
(setf (gethash #\6 *morse-code-encoder*) "-....")
(setf (gethash #\7 *morse-code-encoder*) "--...")
(setf (gethash #\8 *morse-code-encoder*) "---..")
(setf (gethash #\9 *morse-code-encoder*) "----.")
(setf (gethash #\. *morse-code-encoder*) ".-.-.-")
(setf (gethash #\, *morse-code-encoder*) "--..--")
(setf (gethash #\? *morse-code-encoder*) "..--..")
(setf (gethash #\' *morse-code-encoder*) ".----.")
(setf (gethash #\! *morse-code-encoder*) "-.-.--")
(setf (gethash #\/ *morse-code-encoder*) "-..-.")
(setf (gethash #\( *morse-code-encoder*) "-.--.")
(setf (gethash #\) *morse-code-encoder*) "-.--.-")
(setf (gethash #\& *morse-code-encoder*) ".-...")
(setf (gethash #\: *morse-code-encoder*) "---...")
(setf (gethash #\; *morse-code-encoder*) ".-.-.")
(setf (gethash #\= *morse-code-encoder*) "-...-")
(setf (gethash #\+ *morse-code-encoder*) ".-.-.")
(setf (gethash #\- *morse-code-encoder*) "-....-")
(setf (gethash #\_ *morse-code-encoder*) ".--.-")
(setf (gethash #\\ *morse-code-encoder*) ".-..-.")
(setf (gethash #\$ *morse-code-encoder*) "..-..-")
(setf (gethash #\@ *morse-code-encoder*) ".--.-.")

(defun %encode-morse ()
  (let* ((phrase (read-one-line (current-screen) "Text to encode: "
				:initial-input (get-x-selection))))
    (when phrase
      (loop
	 for char across phrase
	 collect (gethash char *morse-code-encoder* char) into parts
	 finally (message "Encoded: ~{~a~^ ~}" parts)))))

(defcommand encode-morse () ()
  (%encode-morse))