--------------------------------------------------------------------------------- |-- Module : System.Hardware.Arduino.SamplePrograms.LCD-- Copyright : (c) Levent Erkok-- License : BSD3-- Maintainer : erkokl@gmail.com-- Stability : experimental---- Basic demo of an Hitachi HD44780 LCD-------------------------------------------------------------------------------{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}moduleSystem.Hardware.Arduino.SamplePrograms.LCDwhereimportControl.Monad.Trans(liftIO)importData.Char(isSpace)importNumeric(showHex)importSystem.Hardware.Arduino importSystem.Hardware.Arduino.Parts.LCD -- | Connections for a basic hitachi controller.-- See <http://en.wikipedia.org/wiki/Hitachi_HD44780_LCD_controller> for-- pin layout. For this demo, simply connect the LCD pins to the Arduino-- as follows:---- * LCD pin @01@ to GND---- * LCD pin @02@ to +5V---- * LCD pin @03@ to a 10K potentiometer's viper---- * LCD pin @04@ to Arduino pin @12@---- * LCD pin @05@ to GND---- * LCD pin @06@ to Arduino pin @11@---- * LCD pin @11@ to Arduino pin @5@---- * LCD pin @12@ to Arduino pin @4@---- * LCD pin @13@ to Arduino pin @3@---- * LCD pin @14@ to Arduino pin @2@---- * [If backlight is needed] LCD pin @15@ to +5V---- * [If backlight is needed] LCD pin @16@ to GND via 220ohm resistor---- <<http://github.com/LeventErkok/hArduino/raw/master/System/Hardware/Arduino/SamplePrograms/Schematics/LCD.png>>hitachi ::LCDController -- Connections: ARDUINO Hitachi Description-------------------------------- ----------- --------- ----------------hitachi :: LCDController
hitachi =Hitachi44780 {lcdRS :: Pin
lcdRS =Word8 -> Pin
digital Word8
12-- 4 Register-select,lcdEN :: Pin
lcdEN =Word8 -> Pin
digital Word8
11-- 6 Enable,lcdD4 :: Pin
lcdD4 =Word8 -> Pin
digital Word8
5-- 11 Data 4,lcdD5 :: Pin
lcdD5 =Word8 -> Pin
digital Word8
4-- 12 Data 5,lcdD6 :: Pin
lcdD6 =Word8 -> Pin
digital Word8
3-- 13 Data 6,lcdD7 :: Pin
lcdD7 =Word8 -> Pin
digital Word8
2-- 14 Data 7-- Other config variables for the display,lcdRows :: Int
lcdRows =Int
2-- 2 rows,lcdCols :: Int
lcdCols =Int
16-- of 16 columns,dotMode5x10 :: Bool
dotMode5x10 =Bool
False-- Using the standard 5x8 dots}-- | The happy glyph. See 'lcdCreateSymbol' for details on how to create new ones.happy ::[String]happy :: [String]
happy =[String
" ",String
"@ @",String
" ",String
" ",String
"@ @",String
" @@@ ",String
" ",String
" "]-- | The sad glyph. See 'lcdCreateSymbol' for details on how to create new ones.sad ::[String]sad :: [String]
sad =[String
" ",String
"@ @",String
" ",String
" ",String
" ",String
" @@@ ",String
"@ @",String
" "]-- | Access the LCD connected to Arduino, making it show messages-- we read from the user and demonstrate other LCD control features offered-- by hArduino.lcdDemo ::IO()lcdDemo :: IO ()
lcdDemo =Bool -> String -> Arduino () -> IO ()
withArduino Bool
FalseString
"/dev/cu.usbmodemFD131"forall a b. (a -> b) -> a -> b
$doLCD
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
liftIOforall a b. (a -> b) -> a -> b
$doString -> IO ()
putStrLnString
"Hitachi controller demo.."String -> IO ()
putStrLnString
""String -> IO ()
putStrLnString
"Looking for an example? Try the following sequence:"String -> IO ()
putStrLnString
" cursor 5 0"String -> IO ()
putStrLnString
" happy"String -> IO ()
putStrLnString
" write _"String -> IO ()
putStrLnString
" happy"String -> IO ()
putStrLnString
" flash 5"String -> IO ()
putStrLnString
""String -> IO ()
putStrLnString
"Type ? to see all available commands."letrepl :: Arduino ()
repl =doforall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIOforall a b. (a -> b) -> a -> b
$String -> IO ()
putStrString
"LCD> "String
m <-forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIOIO String
getLinecaseString -> [String]
wordsString
m of[]->Arduino ()
repl [String
"quit"]->forall (m :: * -> *) a. Monad m => a -> m a
return()(String
cmd :[String]
_)->caseString
cmd forall a b. Eq a => a -> [(a, b)] -> Maybe b
`lookup`[(String,
 (String, String,
 LCD -> String -> (LCDSymbol, LCDSymbol) -> Arduino ()))]
commands ofMaybe
 (String, String,
 LCD -> String -> (LCDSymbol, LCDSymbol) -> Arduino ())
Nothing->doforall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIOforall a b. (a -> b) -> a -> b
$String -> IO ()
putStrLnforall 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 )->doLCD -> String -> (LCDSymbol, LCDSymbol) -> Arduino ()
c LCD
lcd (forall a. (a -> Bool) -> [a] -> [a]
dropWhileChar -> Bool
isSpace(forall a. Int -> [a] -> [a]
drop(forall (t :: * -> *) a. Foldable t => t a -> Int
lengthString
cmd )String
m ))(LCDSymbol
happySymbol ,LCDSymbol
sadSymbol )Arduino ()
repl Arduino ()
repl wherehelp :: Arduino ()
help =forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIOforall a b. (a -> b) -> a -> b
$dolet([String]
cmds ,[String]
args ,[String]
hlps )=forall a b c. [(a, b, c)] -> ([a], [b], [c])
unzip3forall 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
1forall a. Num a => a -> a -> a
+forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum(forall a b. (a -> b) -> [a] -> [b]
mapforall (t :: * -> *) a. Foldable t => t a -> Int
length[String]
cmds )alen :: Int
alen =Int
8forall a. Num a => a -> a -> a
+forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum(forall a b. (a -> b) -> [a] -> [b]
mapforall (t :: * -> *) a. Foldable t => t a -> Int
length[String]
args )pad :: Int -> String -> String
pad Int
l String
s =forall a. Int -> [a] -> [a]
takeInt
l (String
s forall a. [a] -> [a] -> [a]
++forall a. a -> [a]
repeatChar
' ')line :: (String, String, String) -> IO ()
line (String
c ,String
a ,String
h )=String -> IO ()
putStrLnforall 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
liftIOforall a b. (a -> b) -> a -> b
$String -> IO ()
putStrLnforall 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
liftIOforall a b. (a -> b) -> a -> b
$String -> IO ()
putStrLnforall 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
idgrabNums :: 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]
mapforall a. Read a => ReadS a
reads(String -> [String]
wordsString
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
liftIOforall a b. (a -> b) -> a -> b
$String -> IO ()
putStrLnforall a b. (a -> b) -> a -> b
$String
"Need "forall a. [a] -> [a] -> [a]
++forall a. Show a => a -> String
showInt
n forall a. [a] -> [a] -> [a]
++String
" numeric parameter"forall a. [a] -> [a] -> [a]
++ifInt
n forall a. Eq a => a -> a -> Bool
==Int
1thenString
"."elseString
"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 (ifBool
isHappy thenLCDSymbol
h elseLCDSymbol
s )cursor :: LCD -> String -> Arduino ()
cursor LCD
lcd String
a =forall {a} {m :: * -> *}.
(Read a, MonadIO m) =>
Int -> String -> ([a] -> m ()) -> m ()
grabNums Int
2String
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
1String
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
1String
a (\[Word8
n ]->doLCD -> 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
showHexWord8
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
1String
a (\[Int
n ]->doletscr :: 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]
concatforall a b. (a -> b) -> a -> b
$forall a. Int -> a -> [a]
replicateInt
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 ))]