Today I added audio support to the morse translator that I made yesterday. There ought to be a screencast of me demoing it, but screenr is being a dick, as it sometimes is for no discernable reason.

I found the admirably minimalistic Data.WAVE library with a little bit of searching. This I installed by typing $ cabal install WAVE

When Data.WAVE is combined with a function called "sound" that David Milani posted on stack overflow it becomes pretty straightforward to define sounds for the dits and dahs. And for the spaces between them. I used the gaps suggested by the wikipedia article -- 1 dit between dits and dahs, one dah between letters and 7 dits between words. The function turns a sound into a big array of samples, which are actually Int32s.

With that infrastructure in place I added 3 new command line options to morse.hs

-v

Turns up the verbosity, which was handy for debugging

-a

Rather than putting a string in the terminal outputs your morse as a wav in morse-out.wav

-p

Tries to use aplay to play morse-out.wav after it is created.

So now I can run my script to generate exciting morse sounds like these!

As @russelbanned pointed out on twitter, it would also be nice to be able to listen to the audio and get morse or a string out. But that is a project for another day.

morse.hs

Here is the actual code in its current iteration. module Main where import qualified Data.Map as M (Map, toList, fromList, lookup) import System.Console.GetOpt import System.Process import Data.Maybe (fromMaybe) import Data.Char (toLower) import System.Environment import Data.WAVE import Data.List (intersperse) import Data.Int (Int32) import Data.List.Split (splitOn) data Options = Options { optUnmorse :: Bool, optAudio :: Bool, optPlayAudio :: Bool, optVerbose :: Bool } deriving Show type MorseString = String defaultOptions :: Options defaultOptions = Options { optUnmorse = False, optAudio = False, optPlayAudio = False, optVerbose = False } options :: [OptDescr (Options -> Options)] options = [ Option ['u'] ["unmorse"] (NoArg (\ opts -> opts { optUnmorse = True })) "Translate from morse back to string", Option ['a'] ["audio"] (NoArg (\ opts -> opts { optAudio = True })) "Translate from string to audio. Output file to morse-out.wav and play using aplay", Option ['p'] ["playaudio"] (NoArg (\ opts -> opts { optPlayAudio = True })) "Play morse-out.wav using aplay", Option ['v'] ["verbose"] (NoArg (\ opts -> opts { optVerbose = True })) "Go on about it at great length" ] myOpts :: [String] -> IO (Options, [String]) myOpts argv = case getOpt Permute options argv of (o,n,[] ) -> return (foldl (flip id) defaultOptions o, n) (_,_,errs) -> ioError (userError (concat errs ++ usageInfo header options)) where header = "Usage: morse [uavp] < file" letters :: (M.Map Char MorseString) letters = M.fromList [ ('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', "--..") , ('1', ".----") , ('2', "..---") , ('3', "...--") , ('4', "....-") , ('5', ".....") , ('6', "-....") , ('7', "--...") , ('8', "---..") , ('9', "----.") , ('0', "-----") , (' ', "_") , ('.', "_") ] invertLetters = M.fromList $ map (\(x,y) -> (y,x)) $ M.toList letters charToMorse :: Char -> MorseString charToMorse x = case M.lookup (toLower x) letters of Just x' -> x' ++ " " Nothing -> "" stringToMorse :: String -> MorseString stringToMorse xs = m ++ "\n" where m = concatMap charToMorse xs morseToChar :: MorseString -> Char morseToChar x = case M.lookup x invertLetters of Just x' -> x' Nothing -> '?' morseToString :: MorseString -> String morseToString xs = s ++ "\n" where s = map morseToChar $ words xs -- Sound implementation samplesPS = 16000 -- samples per second bitrate = 16 -- or 32 bit if you need beepFreq = 800 -- dits and dahs come out at this frequency operatorSpeedFactor = 4 -- higher is slower, could make this into a commandline option morseSpeed = operatorSpeedFactor/10 -- Used in the file header header :: WAVEHeader header = WAVEHeader 1 samplesPS bitrate Nothing -- From an answer by David Milani at: -- https://stackoverflow.com/questions/5658391/generating-wav-sound-data-in-haskell sound :: Double -- | Frequency -> Int -- | Samples per second -> Double -- | Length of sound in seconds -> Int32 -- | Volume, (maxBound :: Int32) for highest, 0 for lowest -> [Int32] sound freq samples len volume = take (round $ len * (fromIntegral samples)) $ map (round . (* fromIntegral volume)) $ map sin [0.0, (freq * 2 * pi / (fromIntegral samples))..] -- space between dots and dahs space :: [Int32] space = sound 0 samplesPS (morseSpeed * 0.25) 0 -- gap between words longSpace :: [Int32] longSpace = sound 0 samplesPS (morseSpeed * 1.25) 0 medSpace :: [Int32] medSpace = sound 0 samplesPS (morseSpeed * 0.5) 0 dit :: [Int32] dit = sound beepFreq samplesPS (morseSpeed * 0.25) (maxBound `div` 2) dah :: [Int32] dah = sound beepFreq samplesPS (morseSpeed * 0.75) (maxBound `div` 2) stringToMorseWavFile :: String -> IO () stringToMorseWavFile xs = makeWavFile $ concatMap (map (:[])) $ stringToMorseSounds xs stringToMorseSounds :: String -> [[Int32]] stringToMorseSounds xs = map charToMorseSound $ stringToMorse xs charToMorseSound :: Char -> [Int32] charToMorseSound x = case x of '.' -> concat [dit,space] '-' -> concat [dah,space] '_' -> longSpace ' ' -> medSpace otherwise -> space makeWavFile :: Data.WAVE.WAVESamples -> IO () makeWavFile xs = putWAVEFile "morse-out.wav" (WAVE header xs) main :: IO () main = do (os, _) <- getArgs >>= myOpts if optUnmorse os then interact morseToString else if optAudio os then do xs <- getContents putStr $ verboseWav os xs stringToMorseWavFile xs if optPlayAudio os then do putStr $ verbosePlay os xs pid <- runCommand "aplay -q morse-out.wav" waitForProcess pid return () else return () else interact stringToMorse where verboseWav os xs = if optVerbose os then stringToMorse xs ++ "Writing to morse-out.wav\n" else "" verbosePlay os xs = if optVerbose os then "Playing morse-out.wav\n" else ""

Pic from wikipedia, courtesy of Lou Sadler, under public domain.