{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
module System.Hardware.Arduino.SamplePrograms.LCD where
import Control.Monad.Trans (liftIO)
import Data.Char (isSpace)
import Numeric (showHex)
import System.Hardware.Arduino
import System.Hardware.Arduino.Parts.LCD
hitachi :: LCDController
hitachi :: LCDController
hitachi = Hitachi44780 { lcdRS :: Pin
lcdRS = Word8 -> Pin
digital Word8
12
, lcdEN :: Pin
lcdEN = Word8 -> Pin
digital Word8
11
, lcdD4 :: Pin
lcdD4 = Word8 -> Pin
digital Word8
5
, lcdD5 :: Pin
lcdD5 = Word8 -> Pin
digital Word8
4
, lcdD6 :: Pin
lcdD6 = Word8 -> Pin
digital Word8
3
, lcdD7 :: Pin
lcdD7 = Word8 -> Pin
digital Word8
2
, lcdRows :: Int
lcdRows = Int
2
, lcdCols :: Int
lcdCols = Int
16
, dotMode5x10 :: Bool
dotMode5x10 = Bool
False
}
happy :: [String]
happy :: [String]
happy = [ String
" "
, String
"@ @"
, String
" "
, String
" "
, String
"@ @"
, String
" @@@ "
, String
" "
, String
" "
]
sad :: [String]
sad :: [String]
sad = [ String
" "
, String
"@ @"
, String
" "
, String
" "
, String
" "
, String
" @@@ "
, String
"@ @"
, String
" "
]
lcdDemo :: IO ()
lcdDemo :: IO ()
lcdDemo = Bool -> String -> Arduino () -> IO ()
withArduino Bool
False String
"/dev/cu.usbmodemFD131" (Arduino () -> IO ()) -> Arduino () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
LCD
lcd <- LCDController -> Arduino LCD
lcdRegister LCDController
hitachi
LCDSymbol
happySymbol <- LCD -> [String] -> Arduino LCDSymbol
lcdCreateSymbol LCD
lcd [String]
happy
LCDSymbol
sadSymbol <- LCD -> [String] -> Arduino LCDSymbol
lcdCreateSymbol LCD
lcd [String]
sad
LCD -> Arduino ()
lcdHome LCD
lcd
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
$ do String -> IO ()
putStrLn String
"Hitachi controller demo.."
String -> IO ()
putStrLn String
""
String -> IO ()
putStrLn String
"Looking for an example? Try the following sequence:"
String -> IO ()
putStrLn String
" cursor 5 0"
String -> IO ()
putStrLn String
" happy"
String -> IO ()
putStrLn String
" write _"
String -> IO ()
putStrLn String
" happy"
String -> IO ()
putStrLn String
" flash 5"
String -> IO ()
putStrLn String
""
String -> IO ()
putStrLn String
"Type ? to see all available commands."
let repl :: Arduino ()
repl = 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
"LCD> "
String
m <- IO String -> Arduino String
forall a. IO a -> Arduino a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO String
getLine
case String -> [String]
words String
m of
[] -> Arduino ()
repl
[String
"quit"] -> () -> Arduino ()
forall a. a -> Arduino a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
(String
cmd:[String]
_) -> case String
cmd String
-> [(String,
(String, String,
LCD -> String -> (LCDSymbol, LCDSymbol) -> Arduino ()))]
-> Maybe
(String, String,
LCD -> String -> (LCDSymbol, LCDSymbol) -> Arduino ())
forall a b. Eq a => a -> [(a, b)] -> Maybe b
`lookup` [(String,
(String, String,
LCD -> String -> (LCDSymbol, LCDSymbol) -> Arduino ()))]
commands of
Maybe
(String, String,
LCD -> String -> (LCDSymbol, LCDSymbol) -> Arduino ())
Nothing -> 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 ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Unknown command '" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
cmd String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"', type ? for help."
Arduino ()
repl
Just (String
_, String
_, LCD -> String -> (LCDSymbol, LCDSymbol) -> Arduino ()
c) -> do LCD -> String -> (LCDSymbol, LCDSymbol) -> Arduino ()
c LCD
lcd ((Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace (Int -> String -> String
forall a. Int -> [a] -> [a]
drop (String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
cmd) String
m)) (LCDSymbol
happySymbol, LCDSymbol
sadSymbol)
Arduino ()
repl
Arduino ()
repl
where help :: Arduino ()
help = 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
$ do let ([String]
cmds, [String]
args, [String]
hlps) = [(String, String, String)] -> ([String], [String], [String])
forall a b c. [(a, b, c)] -> ([a], [b], [c])
unzip3 ([(String, String, String)] -> ([String], [String], [String]))
-> [(String, String, String)] -> ([String], [String], [String])
forall a b. (a -> b) -> a -> b
$ (String
"quit", String
"", String
"Quit the demo") (String, String, String)
-> [(String, String, String)] -> [(String, String, String)]
forall a. a -> [a] -> [a]
: [(String
c, String
a, String
h) | (String
c, (String
a, String
h, LCD -> String -> (LCDSymbol, LCDSymbol) -> Arduino ()
_)) <- [(String,
(String, String,
LCD -> String -> (LCDSymbol, LCDSymbol) -> Arduino ()))]
commands]
clen :: Int
clen = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ((String -> Int) -> [String] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
cmds)
alen :: Int
alen = Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ((String -> Int) -> [String] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
args)
pad :: Int -> String -> String
pad Int
l String
s = Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
l (String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ Char -> String
forall a. a -> [a]
repeat Char
' ')
line :: (String, String, String) -> IO ()
line (String
c, String
a, String
h) = String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ Int -> String -> String
pad Int
clen String
c String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String -> String
pad Int
alen String
a String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
h
((String, String, String) -> IO ())
-> [(String, String, String)] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (String, String, String) -> IO ()
line ([(String, String, String)] -> IO ())
-> [(String, String, String)] -> IO ()
forall a b. (a -> b) -> a -> b
$ [String] -> [String] -> [String] -> [(String, String, String)]
forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 [String]
cmds [String]
args [String]
hlps
arg0 :: m () -> p -> [a] -> p -> m ()
arg0 m ()
f p
_ [] p
_ = m ()
f
arg0 m ()
_ p
_ [a]
a p
_ = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Unexpected arguments: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [a] -> String
forall a. Show a => a -> String
show [a]
a
arg1 :: (t -> m ()) -> t -> [a] -> p -> m ()
arg1 t -> m ()
f t
lcd [] p
_ = t -> m ()
f t
lcd
arg1 t -> m ()
_ t
_ [a]
a p
_ = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Unexpected arguments: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ [a] -> String
forall a. Show a => a -> String
show [a]
a
arg2 :: (t -> t -> t) -> t -> t -> p -> t
arg2 t -> t -> t
f t
lcd t
a p
_ = t -> t -> t
f t
lcd t
a
arg3 :: a -> a
arg3 = a -> a
forall a. a -> a
id
grabNums :: Int -> String -> ([a] -> m ()) -> m ()
grabNums Int
n String
a [a] -> m ()
f = case [a
v | [(a
v, String
"")] <- (String -> [(a, String)]) -> [String] -> [[(a, String)]]
forall a b. (a -> b) -> [a] -> [b]
map String -> [(a, String)]
forall a. Read a => ReadS a
reads (String -> [String]
words String
a)] of
[a]
vs | [a] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
vs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
n -> IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Need " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" numeric parameter" String -> String -> String
forall a. [a] -> [a] -> [a]
++ if Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 then String
"." else String
"s."
[a]
vs -> [a] -> m ()
f [a]
vs
symbol :: Bool -> LCD -> p -> (LCDSymbol, LCDSymbol) -> Arduino ()
symbol Bool
isHappy LCD
lcd p
_ (LCDSymbol
h, LCDSymbol
s) = LCD -> LCDSymbol -> Arduino ()
lcdWriteSymbol LCD
lcd (if Bool
isHappy then LCDSymbol
h else LCDSymbol
s)
cursor :: LCD -> String -> Arduino ()
cursor LCD
lcd String
a = Int -> String -> ([Int] -> Arduino ()) -> Arduino ()
forall {a} {m :: * -> *}.
(Read a, MonadIO m) =>
Int -> String -> ([a] -> m ()) -> m ()
grabNums Int
2 String
a (\[Int
col, Int
row] -> LCD -> (Int, Int) -> Arduino ()
lcdSetCursor LCD
lcd (Int
col, Int
row))
flash :: LCD -> String -> Arduino ()
flash LCD
lcd String
a = Int -> String -> ([Int] -> Arduino ()) -> Arduino ()
forall {a} {m :: * -> *}.
(Read a, MonadIO m) =>
Int -> String -> ([a] -> m ()) -> m ()
grabNums Int
1 String
a (\[Int
n] -> LCD -> Int -> Int -> Arduino ()
lcdFlash LCD
lcd Int
n Int
500)
code :: LCD -> String -> Arduino ()
code LCD
lcd String
a = Int -> String -> ([Word8] -> Arduino ()) -> Arduino ()
forall {a} {m :: * -> *}.
(Read a, MonadIO m) =>
Int -> String -> ([a] -> m ()) -> m ()
grabNums Int
1 String
a (\[Word8
n] -> do LCD -> Arduino ()
lcdClear LCD
lcd
LCD -> Arduino ()
lcdHome LCD
lcd
LCD -> LCDSymbol -> Arduino ()
lcdWriteSymbol LCD
lcd (Word8 -> LCDSymbol
lcdInternalSymbol Word8
n)
LCD -> String -> Arduino ()
lcdWrite LCD
lcd (String -> Arduino ()) -> String -> Arduino ()
forall a b. (a -> b) -> a -> b
$ String
" (Code: 0x" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word8 -> String -> String
forall a. Integral a => a -> String -> String
showHex Word8
n String
"" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")")
scroll :: Bool -> LCD -> String -> Arduino ()
scroll Bool
toLeft LCD
lcd String
a = Int -> String -> ([Int] -> Arduino ()) -> Arduino ()
forall {a} {m :: * -> *}.
(Read a, MonadIO m) =>
Int -> String -> ([a] -> m ()) -> m ()
grabNums Int
1 String
a (\[Int
n] -> do let scr :: LCD -> Arduino ()
scr | Bool
toLeft = LCD -> Arduino ()
lcdScrollDisplayLeft
| Bool
True = LCD -> Arduino ()
lcdScrollDisplayRight
[Arduino ()] -> Arduino ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ ([Arduino ()] -> Arduino ()) -> [Arduino ()] -> Arduino ()
forall a b. (a -> b) -> a -> b
$ [[Arduino ()]] -> [Arduino ()]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Arduino ()]] -> [Arduino ()]) -> [[Arduino ()]] -> [Arduino ()]
forall a b. (a -> b) -> a -> b
$ Int -> [Arduino ()] -> [[Arduino ()]]
forall a. Int -> a -> [a]
replicate Int
n [LCD -> Arduino ()
scr LCD
lcd, Int -> Arduino ()
delay Int
500])
commands :: [(String,
(String, String,
LCD -> String -> (LCDSymbol, LCDSymbol) -> Arduino ()))]
commands = [ (String
"?", (String
"", String
"Display this help message", Arduino () -> LCD -> String -> (LCDSymbol, LCDSymbol) -> Arduino ()
forall {m :: * -> *} {a} {p} {p}.
(MonadIO m, Show a) =>
m () -> p -> [a] -> p -> m ()
arg0 Arduino ()
help))
, (String
"clear", (String
"", String
"Clear the LCD screen", (LCD -> Arduino ())
-> LCD -> String -> (LCDSymbol, LCDSymbol) -> Arduino ()
forall {m :: * -> *} {a} {t} {p}.
(MonadIO m, Show a) =>
(t -> m ()) -> t -> [a] -> p -> m ()
arg1 LCD -> Arduino ()
lcdClear))
, (String
"write", (String
"string", String
"Write to the LCD", (LCD -> String -> Arduino ())
-> LCD -> String -> (LCDSymbol, LCDSymbol) -> Arduino ()
forall {t} {t} {t} {p}. (t -> t -> t) -> t -> t -> p -> t
arg2 LCD -> String -> Arduino ()
lcdWrite))
, (String
"home", (String
"", String
"Move cursor to home", (LCD -> Arduino ())
-> LCD -> String -> (LCDSymbol, LCDSymbol) -> Arduino ()
forall {m :: * -> *} {a} {t} {p}.
(MonadIO m, Show a) =>
(t -> m ()) -> t -> [a] -> p -> m ()
arg1 LCD -> Arduino ()
lcdHome))
, (String
"cursor", (String
"col row", String
"Move cursor to col row", (LCD -> String -> Arduino ())
-> LCD -> String -> (LCDSymbol, LCDSymbol) -> Arduino ()
forall {t} {t} {t} {p}. (t -> t -> t) -> t -> t -> p -> t
arg2 LCD -> String -> Arduino ()
cursor))
, (String
"scrollOff", (String
"", String
"Turn off auto-scroll", (LCD -> Arduino ())
-> LCD -> String -> (LCDSymbol, LCDSymbol) -> Arduino ()
forall {m :: * -> *} {a} {t} {p}.
(MonadIO m, Show a) =>
(t -> m ()) -> t -> [a] -> p -> m ()
arg1 LCD -> Arduino ()
lcdAutoScrollOff))
, (String
"scrollOn", (String
"", String
"Turn on auto-scroll", (LCD -> Arduino ())
-> LCD -> String -> (LCDSymbol, LCDSymbol) -> Arduino ()
forall {m :: * -> *} {a} {t} {p}.
(MonadIO m, Show a) =>
(t -> m ()) -> t -> [a] -> p -> m ()
arg1 LCD -> Arduino ()
lcdAutoScrollOn))
, (String
"scrollLeft", (String
"n", String
"Scroll left by n chars", (LCD -> String -> Arduino ())
-> LCD -> String -> (LCDSymbol, LCDSymbol) -> Arduino ()
forall {t} {t} {t} {p}. (t -> t -> t) -> t -> t -> p -> t
arg2 (Bool -> LCD -> String -> Arduino ()
scroll Bool
True)))
, (String
"scrollRight", (String
"n", String
"Scroll right by n char", (LCD -> String -> Arduino ())
-> LCD -> String -> (LCDSymbol, LCDSymbol) -> Arduino ()
forall {t} {t} {t} {p}. (t -> t -> t) -> t -> t -> p -> t
arg2 (Bool -> LCD -> String -> Arduino ()
scroll Bool
False)))
, (String
"leftToRight", (String
"", String
"Set left to right direction", (LCD -> Arduino ())
-> LCD -> String -> (LCDSymbol, LCDSymbol) -> Arduino ()
forall {m :: * -> *} {a} {t} {p}.
(MonadIO m, Show a) =>
(t -> m ()) -> t -> [a] -> p -> m ()
arg1 LCD -> Arduino ()
lcdLeftToRight))
, (String
"rightToLeft", (String
"", String
"Set left to right direction", (LCD -> Arduino ())
-> LCD -> String -> (LCDSymbol, LCDSymbol) -> Arduino ()
forall {m :: * -> *} {a} {t} {p}.
(MonadIO m, Show a) =>
(t -> m ()) -> t -> [a] -> p -> m ()
arg1 LCD -> Arduino ()
lcdRightToLeft))
, (String
"blinkOn", (String
"", String
"Set blinking ON", (LCD -> Arduino ())
-> LCD -> String -> (LCDSymbol, LCDSymbol) -> Arduino ()
forall {m :: * -> *} {a} {t} {p}.
(MonadIO m, Show a) =>
(t -> m ()) -> t -> [a] -> p -> m ()
arg1 LCD -> Arduino ()
lcdBlinkOn))
, (String
"blinkOff", (String
"", String
"Set blinking ON", (LCD -> Arduino ())
-> LCD -> String -> (LCDSymbol, LCDSymbol) -> Arduino ()
forall {m :: * -> *} {a} {t} {p}.
(MonadIO m, Show a) =>
(t -> m ()) -> t -> [a] -> p -> m ()
arg1 LCD -> Arduino ()
lcdBlinkOff))
, (String
"cursorOn", (String
"", String
"Display the cursor", (LCD -> Arduino ())
-> LCD -> String -> (LCDSymbol, LCDSymbol) -> Arduino ()
forall {m :: * -> *} {a} {t} {p}.
(MonadIO m, Show a) =>
(t -> m ()) -> t -> [a] -> p -> m ()
arg1 LCD -> Arduino ()
lcdCursorOn))
, (String
"cursorOff", (String
"", String
"Do not display the cursor", (LCD -> Arduino ())
-> LCD -> String -> (LCDSymbol, LCDSymbol) -> Arduino ()
forall {m :: * -> *} {a} {t} {p}.
(MonadIO m, Show a) =>
(t -> m ()) -> t -> [a] -> p -> m ()
arg1 LCD -> Arduino ()
lcdCursorOff))
, (String
"displayOn", (String
"", String
"Turn the display on", (LCD -> Arduino ())
-> LCD -> String -> (LCDSymbol, LCDSymbol) -> Arduino ()
forall {m :: * -> *} {a} {t} {p}.
(MonadIO m, Show a) =>
(t -> m ()) -> t -> [a] -> p -> m ()
arg1 LCD -> Arduino ()
lcdDisplayOn))
, (String
"displayOff", (String
"", String
"Turn the display off", (LCD -> Arduino ())
-> LCD -> String -> (LCDSymbol, LCDSymbol) -> Arduino ()
forall {m :: * -> *} {a} {t} {p}.
(MonadIO m, Show a) =>
(t -> m ()) -> t -> [a] -> p -> m ()
arg1 LCD -> Arduino ()
lcdDisplayOff))
, (String
"flash", (String
"n", String
"Flash the display n times", (LCD -> String -> Arduino ())
-> LCD -> String -> (LCDSymbol, LCDSymbol) -> Arduino ()
forall {t} {t} {t} {p}. (t -> t -> t) -> t -> t -> p -> t
arg2 LCD -> String -> Arduino ()
flash))
, (String
"happy", (String
"", String
"Draw a smiling face", (LCD -> String -> (LCDSymbol, LCDSymbol) -> Arduino ())
-> LCD -> String -> (LCDSymbol, LCDSymbol) -> Arduino ()
forall a. a -> a
arg3 (Bool -> LCD -> String -> (LCDSymbol, LCDSymbol) -> Arduino ()
forall {p}.
Bool -> LCD -> p -> (LCDSymbol, LCDSymbol) -> Arduino ()
symbol Bool
True)))
, (String
"sad", (String
"", String
"Draw a sad face", (LCD -> String -> (LCDSymbol, LCDSymbol) -> Arduino ())
-> LCD -> String -> (LCDSymbol, LCDSymbol) -> Arduino ()
forall a. a -> a
arg3 (Bool -> LCD -> String -> (LCDSymbol, LCDSymbol) -> Arduino ()
forall {p}.
Bool -> LCD -> p -> (LCDSymbol, LCDSymbol) -> Arduino ()
symbol Bool
False)))
, (String
"code", (String
"n", String
"Write symbol with code n", (LCD -> String -> Arduino ())
-> LCD -> String -> (LCDSymbol, LCDSymbol) -> Arduino ()
forall {t} {t} {t} {p}. (t -> t -> t) -> t -> t -> p -> t
arg2 LCD -> String -> Arduino ()
code))
]