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 Int -> Morse -> ShowS
[Morse] -> ShowS
Morse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Morse] -> ShowS
$cshowList :: [Morse] -> ShowS
show :: Morse -> String
$cshow :: Morse -> String
showsPrec :: Int -> Morse -> ShowS
$cshowsPrec :: Int -> Morse -> ShowS
Show
dict :: [(Char, [Morse])]
dict :: [(Char, [Morse])]
dict = forall a b. (a -> b) -> [a] -> [b]
map forall {a}. (a, String) -> (a, [Morse])
encode [(Char, String)]
m
where encode :: (a, String) -> (a, [Morse])
encode (a
k, String
s) = (a
k, forall a b. (a -> b) -> [a] -> [b]
map (\Char
c -> if Char
c forall a. Eq a => a -> a -> Bool
== Char
'.' then Morse
Dit else Morse
Dah) String
s)
m :: [(Char, String)]
m = [ (Char
'A', String
".-" ), (Char
'B', String
"-..." ), (Char
'C', String
"-.-." ), (Char
'D', String
"-.." ), (Char
'E', String
"." )
, (Char
'F', String
"..-." ), (Char
'G', String
"--." ), (Char
'H', String
"...." ), (Char
'I', String
".." ), (Char
'J', String
".---" )
, (Char
'K', String
"-.-" ), (Char
'L', String
".-.." ), (Char
'M', String
"--" ), (Char
'N', String
"-." ), (Char
'O', String
"---" )
, (Char
'P', String
".--." ), (Char
'Q', String
"--.-" ), (Char
'R', String
".-." ), (Char
'S', String
"..." ), (Char
'T', String
"-" )
, (Char
'U', String
"..-" ), (Char
'V', String
"...-" ), (Char
'W', String
".--" ), (Char
'X', String
"-..-" ), (Char
'Y', String
"-.--" )
, (Char
'Z', String
"--.." ), (Char
'0', String
"-----"), (Char
'1', String
".----"), (Char
'2', String
"..---"), (Char
'3', String
"...--")
, (Char
'4', String
"....-"), (Char
'5', String
"....."), (Char
'6', String
"-...."), (Char
'7', String
"--..."), (Char
'8', String
"---..")
, (Char
'9', String
"----."), (Char
'+', String
".-.-."), (Char
'/', String
"-..-."), (Char
'=', String
"-...-")
]
decode :: String -> [Morse]
decode :: String -> [Morse]
decode = forall a. [a] -> [[a]] -> [a]
intercalate [Morse
WBreak] forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall a. [a] -> [[a]] -> [a]
intercalate [Morse
LBreak] forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map Char -> [Morse]
cvt) forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
words
where cvt :: Char -> [Morse]
cvt Char
c = forall a. a -> Maybe a -> a
fromMaybe [] forall a b. (a -> b) -> a -> b
$ Char -> Char
toUpper Char
c forall a b. Eq a => a -> [(a, b)] -> Maybe b
`lookup` [(Char, [Morse])]
dict
morsify :: [Morse] -> [Either Int Int]
morsify :: [Morse] -> [Either Int Int]
morsify = forall a b. (a -> b) -> [a] -> [b]
map Morse -> Either Int Int
t
where unit :: Int
unit = Int
300
t :: Morse -> Either Int Int
t Morse
Dit = forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Int
1 forall a. Num a => a -> a -> a
* Int
unit
t Morse
Dah = forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Int
3 forall a. Num a => a -> a -> a
* Int
unit
t Morse
LBreak = forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Int
3 forall a. Num a => a -> a -> a
* Int
unit
t Morse
WBreak = forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ Int
7 forall a. Num a => a -> a -> a
* Int
unit
transmit :: Pin -> String -> Arduino ()
transmit :: Pin -> String -> Arduino ()
transmit Pin
p = forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Either Int Int -> [Arduino ()]
code forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Morse] -> [Either Int Int]
morsify forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [Morse]
decode
where code :: Either Int Int -> [Arduino ()]
code (Left Int
i) = [Pin -> Bool -> Arduino ()
digitalWrite Pin
p Bool
True, Int -> Arduino ()
delay Int
i, Pin -> Bool -> Arduino ()
digitalWrite Pin
p Bool
False, Int -> Arduino ()
delay Int
i]
code (Right Int
i) = [Pin -> Bool -> Arduino ()
digitalWrite Pin
p Bool
False, Int -> Arduino ()
delay Int
i]
morseDemo :: IO ()
morseDemo :: IO ()
morseDemo = Bool -> String -> Arduino () -> IO ()
withArduino Bool
False String
"/dev/cu.usbmodemFD131" forall a b. (a -> b) -> a -> b
$ do
Pin -> PinMode -> Arduino ()
setPinMode Pin
led PinMode
OUTPUT
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever Arduino ()
send
where led :: Pin
led = Word8 -> Pin
digital Word8
13
send :: Arduino ()
send = do forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStr String
"Message? "
String
m <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO String
getLine
Pin -> String -> Arduino ()
transmit Pin
led String
m