module System.Hardware.Arduino.SamplePrograms.Morse where
import Control.Monad (forever)
import Control.Monad.Trans (liftIO)
import Data.Char (toUpper)
import Data.List (intercalate)
import Data.Maybe (fromMaybe)
import System.Hardware.Arduino
data Morse = Dit | Dah | LBreak | WBreak
deriving Show
dict :: [(Char, [Morse])]
dict = map encode m
where encode (k, s) = (k, map (\c -> if c == '.' then Dit else Dah) s)
m = [ ('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', "--.." ), ('0', "-----"), ('1', ".----"), ('2', "..---"), ('3', "...--")
, ('4', "....-"), ('5', "....."), ('6', "-...."), ('7', "--..."), ('8', "---..")
, ('9', "----."), ('+', ".-.-."), ('/', "-..-."), ('=', "-...-")
]
decode :: String -> [Morse]
decode = intercalate [WBreak] . map (intercalate [LBreak] . map cvt) . words
where cvt c = fromMaybe [] $ toUpper c `lookup` dict
morsify :: [Morse] -> [Either Int Int]
morsify = map t
where unit = 300
t Dit = Left $ 1 * unit
t Dah = Left $ 3 * unit
t LBreak = Right $ 3 * unit
t WBreak = Right $ 7 * unit
transmit :: Pin -> String -> Arduino ()
transmit p = sequence_ . concatMap code . morsify . decode
where code (Left i) = [digitalWrite p True, delay i, digitalWrite p False, delay i]
code (Right i) = [digitalWrite p False, delay i]
morseDemo :: IO ()
morseDemo = withArduino False "/dev/cu.usbmodemfd131" $ do
setPinMode led OUTPUT
forever send
where led = digital 13
send = do liftIO $ putStr "Message? "
m <- liftIO getLine
transmit led m