{-# 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" 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
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO 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 forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStr String
"LCD> "
String
m <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO String
getLine
case String -> [String]
words String
m of
[] -> Arduino ()
repl
[String
"quit"] -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
(String
cmd:[String]
_) -> case String
cmd 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 forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ String
"Unknown command '" forall a. [a] -> [a] -> [a]
++ String
cmd 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 (forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace (forall a. Int -> [a] -> [a]
drop (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 = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do let ([String]
cmds, [String]
args, [String]
hlps) = forall a b c. [(a, b, c)] -> ([a], [b], [c])
unzip3 forall a b. (a -> b) -> a -> b
$ (String
"quit", String
"", String
"Quit the demo") 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 forall a. Num a => a -> a -> a
+ forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (forall a b. (a -> b) -> [a] -> [b]
map forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
cmds)
alen :: Int
alen = Int
8 forall a. Num a => a -> a -> a
+ forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (forall a b. (a -> b) -> [a] -> [b]
map forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
args)
pad :: Int -> String -> String
pad Int
l String
s = forall a. Int -> [a] -> [a]
take Int
l (String
s forall a. [a] -> [a] -> [a]
++ forall a. a -> [a]
repeat Char
' ')
line :: (String, String, String) -> IO ()
line (String
c, String
a, String
h) = String -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ Int -> String -> String
pad Int
clen String
c forall a. [a] -> [a] -> [a]
++ Int -> String -> String
pad Int
alen String
a forall a. [a] -> [a] -> [a]
++ String
h
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (String, String, String) -> IO ()
line forall a b. (a -> b) -> a -> b
$ 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
_ = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ String
"Unexpected arguments: " forall a. [a] -> [a] -> [a]
++ 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
_ = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ String
"Unexpected arguments: " forall a. [a] -> [a] -> [a]
++ 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 = 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
"")] <- forall a b. (a -> b) -> [a] -> [b]
map forall a. Read a => ReadS a
reads (String -> [String]
words String
a)] of
[a]
vs | forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
vs forall a. Eq a => a -> a -> Bool
/= Int
n -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ String
"Need " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
n forall a. [a] -> [a] -> [a]
++ String
" numeric parameter" forall a. [a] -> [a] -> [a]
++ if Int
n 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 = 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 = 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 = 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 forall a b. (a -> b) -> a -> b
$ String
" (Code: 0x" forall a. [a] -> [a] -> [a]
++ forall a. (Integral a, Show a) => a -> String -> String
showHex Word8
n String
"" forall a. [a] -> [a] -> [a]
++ String
")")
scroll :: Bool -> LCD -> String -> Arduino ()
scroll Bool
toLeft LCD
lcd String
a = 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
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ 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", 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", 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", 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", 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", 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", 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", 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", 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", 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", 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", 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", 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", 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", 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", 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", 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", 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", 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", forall a. a -> a
arg3 (forall {p}.
Bool -> LCD -> p -> (LCDSymbol, LCDSymbol) -> Arduino ()
symbol Bool
True)))
, (String
"sad", (String
"", String
"Draw a sad face", forall a. a -> a
arg3 (forall {p}.
Bool -> LCD -> p -> (LCDSymbol, LCDSymbol) -> Arduino ()
symbol Bool
False)))
, (String
"code", (String
"n", String
"Write symbol with code n", forall {t} {t} {t} {p}. (t -> t -> t) -> t -> t -> p -> t
arg2 LCD -> String -> Arduino ()
code))
]