-------------------------------------------------------------------------------
-- |
-- Module      :  System.Hardware.Arduino.SamplePrograms.Morse
-- Copyright   :  (c) Antoine R. Dumont, Levent Erkok
-- License     :  BSD3
-- Maintainer  :  erkokl@gmail.com
-- Stability   :  experimental
--
-- Morse code blinker. Original by Antoine R. Dumont, modified to simplify
-- and fit into the existing examples structure.
-------------------------------------------------------------------------------
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

-- | A dit or a dah is all we need for Morse:
-- A @dit@ is a dot; and a @dah@ is a dash in the Morsian world.
-- We use 'LBreak' and 'WBreak' to indicate a letter and a word break
-- so we can insert some delay between letters and words as we
-- transmit.
data Morse = Dit | Dah | LBreak | WBreak
           deriving Int -> Morse -> ShowS
[Morse] -> ShowS
Morse -> String
(Int -> Morse -> ShowS)
-> (Morse -> String) -> ([Morse] -> ShowS) -> Show Morse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Morse -> ShowS
showsPrec :: Int -> Morse -> ShowS
$cshow :: Morse -> String
show :: Morse -> String
$cshowList :: [Morse] -> ShowS
showList :: [Morse] -> ShowS
Show

-- | Morse code dictionary
dict :: [(Char, [Morse])]
dict :: [(Char, [Morse])]
dict = ((Char, String) -> (Char, [Morse]))
-> [(Char, String)] -> [(Char, [Morse])]
forall a b. (a -> b) -> [a] -> [b]
map (Char, String) -> (Char, [Morse])
forall {a}. (a, String) -> (a, [Morse])
encode [(Char, String)]
m
  where encode :: (a, String) -> (a, [Morse])
encode (a
k, String
s) = (a
k, (Char -> Morse) -> String -> [Morse]
forall a b. (a -> b) -> [a] -> [b]
map (\Char
c -> if Char
c Char -> Char -> Bool
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
"-...-")
            ]

-- | Given a sentence, decode it. We simply drop any letters that we
-- do not have a mapping for.
decode :: String -> [Morse]
decode :: String -> [Morse]
decode = [Morse] -> [[Morse]] -> [Morse]
forall a. [a] -> [[a]] -> [a]
intercalate [Morse
WBreak] ([[Morse]] -> [Morse])
-> (String -> [[Morse]]) -> String -> [Morse]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> [Morse]) -> [String] -> [[Morse]]
forall a b. (a -> b) -> [a] -> [b]
map ([Morse] -> [[Morse]] -> [Morse]
forall a. [a] -> [[a]] -> [a]
intercalate [Morse
LBreak] ([[Morse]] -> [Morse])
-> (String -> [[Morse]]) -> String -> [Morse]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> [Morse]) -> String -> [[Morse]]
forall a b. (a -> b) -> [a] -> [b]
map Char -> [Morse]
cvt) ([String] -> [[Morse]])
-> (String -> [String]) -> String -> [[Morse]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
words
 where cvt :: Char -> [Morse]
cvt Char
c = [Morse] -> Maybe [Morse] -> [Morse]
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe [Morse] -> [Morse]) -> Maybe [Morse] -> [Morse]
forall a b. (a -> b) -> a -> b
$ Char -> Char
toUpper Char
c Char -> [(Char, [Morse])] -> Maybe [Morse]
forall a b. Eq a => a -> [(a, b)] -> Maybe b
`lookup` [(Char, [Morse])]
dict

-- | Given a morsified sentence, compute the delay times. A 'Left' value means
-- turn the led on that long, a 'Right' value means turn it off that long.
morsify :: [Morse] -> [Either Int Int]
morsify :: [Morse] -> [Either Int Int]
morsify = (Morse -> Either Int Int) -> [Morse] -> [Either Int Int]
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    = Int -> Either Int Int
forall a b. a -> Either a b
Left  (Int -> Either Int Int) -> Int -> Either Int Int
forall a b. (a -> b) -> a -> b
$ Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
unit
        t Morse
Dah    = Int -> Either Int Int
forall a b. a -> Either a b
Left  (Int -> Either Int Int) -> Int -> Either Int Int
forall a b. (a -> b) -> a -> b
$ Int
3 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
unit
        t Morse
LBreak = Int -> Either Int Int
forall a b. b -> Either a b
Right (Int -> Either Int Int) -> Int -> Either Int Int
forall a b. (a -> b) -> a -> b
$ Int
3 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
unit
        t Morse
WBreak = Int -> Either Int Int
forall a b. b -> Either a b
Right (Int -> Either Int Int) -> Int -> Either Int Int
forall a b. (a -> b) -> a -> b
$ Int
7 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
unit

-- | Finally, turn a full sentence into a sequence of blink on/off codes
transmit :: Pin -> String -> Arduino ()
transmit :: Pin -> String -> Arduino ()
transmit Pin
p = [Arduino ()] -> Arduino ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ ([Arduino ()] -> Arduino ())
-> (String -> [Arduino ()]) -> String -> Arduino ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Either Int Int -> [Arduino ()])
-> [Either Int Int] -> [Arduino ()]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Either Int Int -> [Arduino ()]
code ([Either Int Int] -> [Arduino ()])
-> (String -> [Either Int Int]) -> String -> [Arduino ()]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Morse] -> [Either Int Int]
morsify ([Morse] -> [Either Int Int])
-> (String -> [Morse]) -> String -> [Either Int Int]
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]

-- | A simple demo driver. To run this example, you only need the Arduino connected to your
-- computer, no other hardware is needed. We use the internal led on pin 13. Of course,
-- you can attach a led to pin 13 as well, for artistic effect.
--
--  <<http://github.com/LeventErkok/hArduino/raw/master/System/Hardware/Arduino/SamplePrograms/Schematics/Blink.png>>
morseDemo :: IO ()
morseDemo :: IO ()
morseDemo = Bool -> String -> Arduino () -> IO ()
withArduino Bool
False String
"/dev/cu.usbmodemFD131" (Arduino () -> IO ()) -> Arduino () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
                Pin -> PinMode -> Arduino ()
setPinMode Pin
led PinMode
OUTPUT
                Arduino () -> Arduino ()
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 IO () -> Arduino ()
forall a. IO a -> Arduino a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Arduino ()) -> IO () -> Arduino ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStr String
"Message? "
                  m <- IO String -> Arduino String
forall a. IO a -> Arduino a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO String
getLine
                  transmit led m