--------------------------------------------------------------------------------------------------- |-- Module : System.Hardware.Arduino.Parts.LCD-- Copyright : (c) Levent Erkok-- License : BSD3-- Maintainer : erkokl@gmail.com-- Stability : experimental---- LCD (Liquid Crystal Display) parts supported by hArduino. The Haskell code-- below has partly been implemented following the Arduino LiquidCrystal project-- source code: <http://code.google.com/p/arduino/source/browse/trunk/libraries/LiquidCrystal/>---- The Hitachi44780 data sheet is at: <http://lcd-linux.sourceforge.net/pdfdocs/hd44780.pdf>---- For an example program using this library, see "System.Hardware.Arduino.SamplePrograms.LCD".-------------------------------------------------------------------------------------------------{-# LANGUAGE NamedFieldPuns #-}{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}moduleSystem.Hardware.Arduino.Parts.LCD(-- * LCD types and registrationLCD ,LCDController (..),lcdRegister -- * Writing text on the LCD,lcdClear ,lcdWrite -- * Moving the cursor,lcdHome ,lcdSetCursor -- * Scrolling,lcdAutoScrollOn ,lcdAutoScrollOff ,lcdScrollDisplayLeft ,lcdScrollDisplayRight -- * Display properties,lcdLeftToRight ,lcdRightToLeft ,lcdBlinkOn ,lcdBlinkOff ,lcdCursorOn ,lcdCursorOff ,lcdDisplayOn ,lcdDisplayOff -- * Accessing internal symbols,,LCDSymbol ,lcdInternalSymbol ,lcdWriteSymbol -- Creating custom symbols,lcdCreateSymbol -- * Misc helpers,lcdFlash )whereimportControl.Concurrent(modifyMVar,withMVar)importControl.Monad(when)importControl.Monad.State(gets,liftIO)importData.Bits(testBit,(.|.),(.&.),setBit,clearBit,shiftL,bit)importData.Char(ord,isSpace)importData.Maybe(fromMaybe)importData.Word(Word8)importqualifiedData.MapasMimportSystem.Hardware.Arduino.Data importSystem.Hardware.Arduino.Firmata importqualifiedSystem.Hardware.Arduino.Utils asUimportSystem.Exit(exitFailure)----------------------------------------------------------------------------------------- Low level interface, not available to the user----------------------------------------------------------------------------------------- | Commands understood by HitachidataCmd =LCD_INITIALIZE |LCD_INITIALIZE_END |LCD_FUNCTIONSET |LCD_DISPLAYCONTROL Word8|LCD_CLEARDISPLAY |LCD_ENTRYMODESET Word8|LCD_RETURNHOME |LCD_SETDDRAMADDR Word8|LCD_CURSORSHIFT Word8|LCD_SETCGRAMADDR Word8-- | Convert a command to a data-wordgetCmdVal ::LCDController ->Cmd ->Word8getCmdVal :: LCDController -> Cmd -> Word8
getCmdVal Hitachi44780 {Int
lcdRows :: LCDController -> Int
lcdRows :: Int
lcdRows ,Bool
dotMode5x10 :: LCDController -> Bool
dotMode5x10 :: Bool
dotMode5x10 }=Cmd -> Word8
get wheremultiLine :: Word8
multiLine -- bit 3|Int
lcdRows forall a. Ord a => a -> a -> Bool
>Int
1=Word8
0x08::Word8|Bool
True=Word8
0x00::Word8dotMode :: Word8
dotMode -- bit 2|Bool
dotMode5x10 =Word8
0x04::Word8|Bool
True=Word8
0x00::Word8displayFunction :: Word8
displayFunction =Word8
multiLine forall a. Bits a => a -> a -> a
.|.Word8
dotMode get :: Cmd -> Word8
get Cmd
LCD_INITIALIZE =Word8
0x33get Cmd
LCD_INITIALIZE_END =Word8
0x32get Cmd
LCD_FUNCTIONSET =Word8
0x20forall a. Bits a => a -> a -> a
.|.Word8
displayFunction get (LCD_DISPLAYCONTROL Word8
w )=Word8
0x08forall a. Bits a => a -> a -> a
.|.Word8
w get Cmd
LCD_CLEARDISPLAY =Word8
0x01get (LCD_ENTRYMODESET Word8
w )=Word8
0x04forall a. Bits a => a -> a -> a
.|.Word8
w get Cmd
LCD_RETURNHOME =Word8
0x02get (LCD_SETDDRAMADDR Word8
w )=Word8
0x80forall a. Bits a => a -> a -> a
.|.Word8
w get (LCD_CURSORSHIFT Word8
w )=Word8
0x10forall a. Bits a => a -> a -> a
.|.Word8
0x08forall a. Bits a => a -> a -> a
.|.Word8
w -- NB. LCD_DISPLAYMOVE (0x08) hard coded hereget (LCD_SETCGRAMADDR Word8
w )=Word8
0x40forall a. Bits a => a -> a -> a
.|.Word8
w forall a. Bits a => a -> Int -> a
`shiftL`Int
3-- | Initialize the LCD. Follows the data sheet <http://lcd-linux.sourceforge.net/pdfdocs/hd44780.pdf>,-- page 46; figure 24.initLCD ::LCD ->LCDController ->Arduino ()initLCD :: LCD -> LCDController -> Arduino ()
initLCD LCD
lcd c :: LCDController
c @Hitachi44780 {Pin
lcdRS :: LCDController -> Pin
lcdRS :: Pin
lcdRS ,Pin
lcdEN :: LCDController -> Pin
lcdEN :: Pin
lcdEN ,Pin
lcdD4 :: LCDController -> Pin
lcdD4 :: Pin
lcdD4 ,Pin
lcdD5 :: LCDController -> Pin
lcdD5 :: Pin
lcdD5 ,Pin
lcdD6 :: LCDController -> Pin
lcdD6 :: Pin
lcdD6 ,Pin
lcdD7 :: LCDController -> Pin
lcdD7 :: Pin
lcdD7 }=doString -> Arduino ()
debug String
"Starting the LCD initialization sequence"forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_(Pin -> PinMode -> Arduino ()
`setPinMode` PinMode
OUTPUT )[Pin
lcdRS ,Pin
lcdEN ,Pin
lcdD4 ,Pin
lcdD5 ,Pin
lcdD6 ,Pin
lcdD7 ]-- Wait for 50ms, data-sheet says at least 40ms for 2.7V version, so be safeInt -> Arduino ()
delay Int
50LCDController -> Cmd -> Arduino ()
sendCmd LCDController
c Cmd
LCD_INITIALIZE Int -> Arduino ()
delay Int
5LCDController -> Cmd -> Arduino ()
sendCmd LCDController
c Cmd
LCD_INITIALIZE_END LCDController -> Cmd -> Arduino ()
sendCmd LCDController
c Cmd
LCD_FUNCTIONSET LCD -> Arduino ()
lcdCursorOff LCD
lcd LCD -> Arduino ()
lcdBlinkOff LCD
lcd LCD -> Arduino ()
lcdLeftToRight LCD
lcd LCD -> Arduino ()
lcdAutoScrollOff LCD
lcd LCD -> Arduino ()
lcdHome LCD
lcd LCD -> Arduino ()
lcdClear LCD
lcd LCD -> Arduino ()
lcdDisplayOn LCD
lcd -- | Get the controller associated with the LCDgetController ::LCD ->Arduino LCDController getController :: LCD -> Arduino LCDController
getController LCD
lcd =doMVar BoardState
bs <-forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
getsArduinoState -> MVar BoardState
boardState String -> [String] -> IO ()
err <-forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
getsArduinoState -> String -> [String] -> IO ()
bailOut forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIOforall a b. (a -> b) -> a -> b
$forall a b. MVar a -> (a -> IO b) -> IO b
withMVarMVar BoardState
bs forall a b. (a -> b) -> a -> b
$\BoardState
bst ->caseLCD
lcd forall k a. Ord k => k -> Map k a -> Maybe a
`M.lookup`BoardState -> Map LCD LCDData
lcds BoardState
bst ofMaybe LCDData
Nothing->doString -> [String] -> IO ()
err (String
"hArduino: Cannot locate "forall a. [a] -> [a] -> [a]
++forall a. Show a => a -> String
showLCD
lcd )[]forall a. IO a
exitFailureJustLCDData
ld ->forall (m :: * -> *) a. Monad m => a -> m a
returnforall a b. (a -> b) -> a -> b
$LCDData -> LCDController
lcdController LCDData
ld -- | Send a command to the LCD controllersendCmd ::LCDController ->Cmd ->Arduino ()sendCmd :: LCDController -> Cmd -> Arduino ()
sendCmd LCDController
c =Bool -> LCDController -> Word8 -> Arduino ()
transmit Bool
FalseLCDController
c forall b c a. (b -> c) -> (a -> b) -> a -> c
.LCDController -> Cmd -> Word8
getCmdVal LCDController
c -- | Send 4-bit data to the LCD controllersendData ::LCDController ->Word8->Arduino ()sendData :: LCDController -> Word8 -> Arduino ()
sendData LCDController
lcd Word8
n =doString -> Arduino ()
debug forall a b. (a -> b) -> a -> b
$String
"Transmitting LCD data: "forall a. [a] -> [a] -> [a]
++Word8 -> String
U.showByte Word8
n Bool -> LCDController -> Word8 -> Arduino ()
transmit Bool
TrueLCDController
lcd Word8
n -- | By controlling the enable-pin, indicate to the controller that-- the data is ready for it to process.pulseEnable ::LCDController ->Arduino ()pulseEnable :: LCDController -> Arduino ()
pulseEnable Hitachi44780 {Pin
lcdEN :: Pin
lcdEN :: LCDController -> Pin
lcdEN }=doString -> Arduino ()
debug String
"Sending LCD pulseEnable"Pin -> Bool -> Arduino ()
digitalWrite Pin
lcdEN Bool
FalseInt -> Arduino ()
delay Int
1Pin -> Bool -> Arduino ()
digitalWrite Pin
lcdEN Bool
TrueInt -> Arduino ()
delay Int
1Pin -> Bool -> Arduino ()
digitalWrite Pin
lcdEN Bool
FalseInt -> Arduino ()
delay Int
1-- | Transmit data down to the LCDtransmit ::Bool->LCDController ->Word8->Arduino ()transmit :: Bool -> LCDController -> Word8 -> Arduino ()
transmit Bool
mode c :: LCDController
c @Hitachi44780 {Pin
lcdRS :: Pin
lcdRS :: LCDController -> Pin
lcdRS ,Pin
lcdEN :: Pin
lcdEN :: LCDController -> Pin
lcdEN ,Pin
lcdD4 :: Pin
lcdD4 :: LCDController -> Pin
lcdD4 ,Pin
lcdD5 :: Pin
lcdD5 :: LCDController -> Pin
lcdD5 ,Pin
lcdD6 :: Pin
lcdD6 :: LCDController -> Pin
lcdD6 ,Pin
lcdD7 :: Pin
lcdD7 :: LCDController -> Pin
lcdD7 }Word8
val =doPin -> Bool -> Arduino ()
digitalWrite Pin
lcdRS Bool
mode Pin -> Bool -> Arduino ()
digitalWrite Pin
lcdEN Bool
Falselet[Bool
b7 ,Bool
b6 ,Bool
b5 ,Bool
b4 ,Bool
b3 ,Bool
b2 ,Bool
b1 ,Bool
b0 ]=[Word8
val forall a. Bits a => a -> Int -> Bool
`testBit`Int
i |Int
i <-[Int
7,Int
6..Int
0]]-- Send down the first 4 bitsPin -> Bool -> Arduino ()
digitalWrite Pin
lcdD4 Bool
b4 Pin -> Bool -> Arduino ()
digitalWrite Pin
lcdD5 Bool
b5 Pin -> Bool -> Arduino ()
digitalWrite Pin
lcdD6 Bool
b6 Pin -> Bool -> Arduino ()
digitalWrite Pin
lcdD7 Bool
b7 LCDController -> Arduino ()
pulseEnable LCDController
c -- Send down the remaining batchPin -> Bool -> Arduino ()
digitalWrite Pin
lcdD4 Bool
b0 Pin -> Bool -> Arduino ()
digitalWrite Pin
lcdD5 Bool
b1 Pin -> Bool -> Arduino ()
digitalWrite Pin
lcdD6 Bool
b2 Pin -> Bool -> Arduino ()
digitalWrite Pin
lcdD7 Bool
b3 LCDController -> Arduino ()
pulseEnable LCDController
c -- | Helper function to simplify library programming, not exposed to the user.withLCD ::LCD ->String->(LCDController ->Arduino a )->Arduino a withLCD :: forall a.
LCD -> String -> (LCDController -> Arduino a) -> Arduino a
withLCD LCD
lcd String
what LCDController -> Arduino a
action =doString -> Arduino ()
debug String
what LCDController
c <-LCD -> Arduino LCDController
getController LCD
lcd LCDController -> Arduino a
action LCDController
c ----------------------------------------------------------------------------------------- High level interface, exposed to the user----------------------------------------------------------------------------------------- | Register an LCD controller. When registration is complete, the LCD will be initialized so that:---- * Set display ON (Use 'lcdDisplayOn' / 'lcdDisplayOff' to change.)---- * Set cursor OFF (Use 'lcdCursorOn' / 'lcdCursorOff' to change.)---- * Set blink OFF (Use 'lcdBlinkOn' / 'lcdBlinkOff' to change.)---- * Clear display (Use 'lcdClear' to clear, 'lcdWrite' to display text.)---- * Set entry mode left to write (Use 'lcdLeftToRight' / 'lcdRightToLeft' to control.)---- * Set autoscrolling OFF (Use 'lcdAutoScrollOff' / 'lcdAutoScrollOn' to control.)---- * Put the cursor into home position (Use 'lcdSetCursor' or 'lcdHome' to move around.)lcdRegister ::LCDController ->Arduino LCD lcdRegister :: LCDController -> Arduino LCD
lcdRegister LCDController
controller =doMVar BoardState
bs <-forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
getsArduinoState -> MVar BoardState
boardState LCD
lcd <-forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIOforall a b. (a -> b) -> a -> b
$forall a b. MVar a -> (a -> IO (a, b)) -> IO b
modifyMVarMVar BoardState
bs forall a b. (a -> b) -> a -> b
$\BoardState
bst ->doletn :: Int
n =forall k a. Map k a -> Int
M.sizeforall a b. (a -> b) -> a -> b
$BoardState -> Map LCD LCDData
lcds BoardState
bst ld :: LCDData
ld =LCDData {lcdDisplayMode :: Word8
lcdDisplayMode =Word8
0,lcdDisplayControl :: Word8
lcdDisplayControl =Word8
0,lcdGlyphCount :: Word8
lcdGlyphCount =Word8
0,lcdController :: LCDController
lcdController =LCDController
controller }forall (m :: * -> *) a. Monad m => a -> m a
return(BoardState
bst {lcds :: Map LCD LCDData
lcds =forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert(Int -> LCD
LCD Int
n )LCDData
ld (BoardState -> Map LCD LCDData
lcds BoardState
bst )},Int -> LCD
LCD Int
n )caseLCDController
controller ofHitachi44780 {}->LCD -> LCDController -> Arduino ()
initLCD LCD
lcd LCDController
controller forall (m :: * -> *) a. Monad m => a -> m a
returnLCD
lcd -- | Write a string on the LCD at the current cursor positionlcdWrite ::LCD ->String->Arduino ()lcdWrite :: LCD -> String -> Arduino ()
lcdWrite LCD
lcd String
m =forall a.
LCD -> String -> (LCDController -> Arduino a) -> Arduino a
withLCD LCD
lcd (String
"Writing "forall a. [a] -> [a] -> [a]
++forall a. Show a => a -> String
showString
m forall a. [a] -> [a] -> [a]
++String
" to LCD")forall a b. (a -> b) -> a -> b
$\LCDController
c ->forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_(LCDController -> Word8 -> Arduino ()
sendData LCDController
c )[Word8]
m' wherem' :: [Word8]
m' =forall a b. (a -> b) -> [a] -> [b]
map(\Char
ch ->forall a b. (Integral a, Num b) => a -> b
fromIntegral(Char -> Int
ordChar
ch )forall a. Bits a => a -> a -> a
.&.Word8
0xFF)String
m -- | Clear the LCDlcdClear ::LCD ->Arduino ()lcdClear :: LCD -> Arduino ()
lcdClear LCD
lcd =forall a.
LCD -> String -> (LCDController -> Arduino a) -> Arduino a
withLCD LCD
lcd String
"Sending clearLCD"forall a b. (a -> b) -> a -> b
$\LCDController
c ->doLCDController -> Cmd -> Arduino ()
sendCmd LCDController
c Cmd
LCD_CLEARDISPLAY Int -> Arduino ()
delay Int
2-- give some time to make sure LCD is really cleared-- | Send the cursor to home positionlcdHome ::LCD ->Arduino ()lcdHome :: LCD -> Arduino ()
lcdHome LCD
lcd =forall a.
LCD -> String -> (LCDController -> Arduino a) -> Arduino a
withLCD LCD
lcd String
"Sending the cursor home"forall a b. (a -> b) -> a -> b
$\LCDController
c ->doLCDController -> Cmd -> Arduino ()
sendCmd LCDController
c Cmd
LCD_RETURNHOME Int -> Arduino ()
delay Int
2-- | Set the cursor location. The pair of arguments is the new column and row numbers-- respectively:---- * The first value is the column, the second is the row. (This is counter-intuitive, but-- is in line with what the standard Arduino programmers do, so we follow the same convention.)---- * Counting starts at 0 (both for column and row no)---- * If the new location is out-of-bounds of your LCD, we will put it the cursor to the closest-- possible location on the LCD.lcdSetCursor ::LCD ->(Int,Int)->Arduino ()lcdSetCursor :: LCD -> (Int, Int) -> Arduino ()
lcdSetCursor LCD
lcd (Int
givenCol ,Int
givenRow )=forall a.
LCD -> String -> (LCDController -> Arduino a) -> Arduino a
withLCD LCD
lcd (String
"Sending the cursor to Row: "forall a. [a] -> [a] -> [a]
++forall a. Show a => a -> String
showInt
givenRow forall a. [a] -> [a] -> [a]
++String
" Col: "forall a. [a] -> [a] -> [a]
++forall a. Show a => a -> String
showInt
givenCol )LCDController -> Arduino ()
set whereset :: LCDController -> Arduino ()
set c :: LCDController
c @Hitachi44780 {Int
lcdRows :: Int
lcdRows :: LCDController -> Int
lcdRows ,Int
lcdCols :: LCDController -> Int
lcdCols :: Int
lcdCols }=LCDController -> Cmd -> Arduino ()
sendCmd LCDController
c (Word8 -> Cmd
LCD_SETDDRAMADDR Word8
offset )wherealign ::Int->Int->Word8align :: Int -> Int -> Word8
align Int
i Int
m |Int
i forall a. Ord a => a -> a -> Bool
<Int
0=Word8
0|Int
i forall a. Ord a => a -> a -> Bool
>=Int
m =forall a b. (Integral a, Num b) => a -> b
fromIntegralforall a b. (a -> b) -> a -> b
$Int
m forall a. Num a => a -> a -> a
-Int
1|Bool
True=forall a b. (Integral a, Num b) => a -> b
fromIntegralInt
i col :: Word8
col =Int -> Int -> Word8
align Int
givenCol Int
lcdCols row :: Word8
row =Int -> Int -> Word8
align Int
givenRow Int
lcdRows -- The magic row-offsets come from various web sources-- I don't follow the logic in these numbers, but it seems to workrowOffsets :: [(Word8, Word8)]
rowOffsets =[(Word8
0,Word8
0),(Word8
1,Word8
0x40),(Word8
2,Word8
0x14),(Word8
3,Word8
0x54)]offset :: Word8
offset =Word8
col forall a. Num a => a -> a -> a
+forall a. a -> Maybe a -> a
fromMaybeWord8
0x54(Word8
row forall a b. Eq a => a -> [(a, b)] -> Maybe b
`lookup`[(Word8, Word8)]
rowOffsets )-- | Scroll the display to the left by 1 character. Project idea: Using a tilt sensor, scroll the contents of the display-- left/right depending on the tilt. lcdScrollDisplayLeft ::LCD ->Arduino ()lcdScrollDisplayLeft :: LCD -> Arduino ()
lcdScrollDisplayLeft LCD
lcd =forall a.
LCD -> String -> (LCDController -> Arduino a) -> Arduino a
withLCD LCD
lcd String
"Scrolling display to the left by 1"forall a b. (a -> b) -> a -> b
$\LCDController
c ->LCDController -> Cmd -> Arduino ()
sendCmd LCDController
c (Word8 -> Cmd
LCD_CURSORSHIFT Word8
lcdMoveLeft )wherelcdMoveLeft :: Word8
lcdMoveLeft =Word8
0x00-- | Scroll the display to the right by 1 characterlcdScrollDisplayRight ::LCD ->Arduino ()lcdScrollDisplayRight :: LCD -> Arduino ()
lcdScrollDisplayRight LCD
lcd =forall a.
LCD -> String -> (LCDController -> Arduino a) -> Arduino a
withLCD LCD
lcd String
"Scrolling display to the right by 1"forall a b. (a -> b) -> a -> b
$\LCDController
c ->LCDController -> Cmd -> Arduino ()
sendCmd LCDController
c (Word8 -> Cmd
LCD_CURSORSHIFT Word8
lcdMoveRight )wherelcdMoveRight :: Word8
lcdMoveRight =Word8
0x04-- | Display characteristics helper, set the new control/mode and send-- appropriate commands if anything changedupdateDisplayData ::String->(Word8->Word8,Word8->Word8)->LCD ->Arduino ()updateDisplayData :: String -> (Word8 -> Word8, Word8 -> Word8) -> LCD -> Arduino ()
updateDisplayData String
what (Word8 -> Word8
f ,Word8 -> Word8
g )LCD
lcd =doString -> Arduino ()
debug String
what MVar BoardState
bs <-forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
getsArduinoState -> MVar BoardState
boardState String -> [String] -> IO ()
err <-forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
getsArduinoState -> String -> [String] -> IO ()
bailOut (LCDData {lcdDisplayControl :: LCDData -> Word8
lcdDisplayControl =Word8
oldC ,lcdDisplayMode :: LCDData -> Word8
lcdDisplayMode =Word8
oldM },LCDData {lcdDisplayControl :: LCDData -> Word8
lcdDisplayControl =Word8
newC ,lcdDisplayMode :: LCDData -> Word8
lcdDisplayMode =Word8
newM ,lcdController :: LCDData -> LCDController
lcdController =LCDController
c })<-forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIOforall a b. (a -> b) -> a -> b
$forall a b. MVar a -> (a -> IO (a, b)) -> IO b
modifyMVarMVar BoardState
bs forall a b. (a -> b) -> a -> b
$\BoardState
bst ->caseLCD
lcd forall k a. Ord k => k -> Map k a -> Maybe a
`M.lookup`BoardState -> Map LCD LCDData
lcds BoardState
bst ofMaybe LCDData
Nothing->doString -> [String] -> IO ()
err (String
"hArduino: Cannot locate "forall a. [a] -> [a] -> [a]
++forall a. Show a => a -> String
showLCD
lcd )[]forall a. IO a
exitFailureJustld :: LCDData
ld @LCDData {Word8
lcdDisplayControl :: Word8
lcdDisplayControl :: LCDData -> Word8
lcdDisplayControl ,Word8
lcdDisplayMode :: Word8
lcdDisplayMode :: LCDData -> Word8
lcdDisplayMode }->doletld' :: LCDData
ld' =LCDData
ld {lcdDisplayControl :: Word8
lcdDisplayControl =Word8 -> Word8
f Word8
lcdDisplayControl ,lcdDisplayMode :: Word8
lcdDisplayMode =Word8 -> Word8
g Word8
lcdDisplayMode }forall (m :: * -> *) a. Monad m => a -> m a
return(BoardState
bst {lcds :: Map LCD LCDData
lcds =forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insertLCD
lcd LCDData
ld' (BoardState -> Map LCD LCDData
lcds BoardState
bst )},(LCDData
ld ,LCDData
ld' ))forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when(Word8
oldC forall a. Eq a => a -> a -> Bool
/=Word8
newC )forall a b. (a -> b) -> a -> b
$LCDController -> Cmd -> Arduino ()
sendCmd LCDController
c (Word8 -> Cmd
LCD_DISPLAYCONTROL Word8
newC )forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when(Word8
oldM forall a. Eq a => a -> a -> Bool
/=Word8
newM )forall a b. (a -> b) -> a -> b
$LCDController -> Cmd -> Arduino ()
sendCmd LCDController
c (Word8 -> Cmd
LCD_ENTRYMODESET Word8
newM )-- | Update the display control wordupdateDisplayControl ::String->(Word8->Word8)->LCD ->Arduino ()updateDisplayControl :: String -> (Word8 -> Word8) -> LCD -> Arduino ()
updateDisplayControl String
what Word8 -> Word8
f =String -> (Word8 -> Word8, Word8 -> Word8) -> LCD -> Arduino ()
updateDisplayData String
what (Word8 -> Word8
f ,forall a. a -> a
id)-- | Update the display mode wordupdateDisplayMode ::String->(Word8->Word8)->LCD ->Arduino ()updateDisplayMode :: String -> (Word8 -> Word8) -> LCD -> Arduino ()
updateDisplayMode String
what Word8 -> Word8
g =String -> (Word8 -> Word8, Word8 -> Word8) -> LCD -> Arduino ()
updateDisplayData String
what (forall a. a -> a
id,Word8 -> Word8
g )-- | Various control masks for the Hitachi44780dataHitachi44780Mask =LCD_BLINKON -- ^ bit @0@ Controls whether cursor blinks|LCD_CURSORON -- ^ bit @1@ Controls whether cursor is on|LCD_DISPLAYON -- ^ bit @2@ Controls whether display is on|LCD_ENTRYSHIFTINCREMENT -- ^ bit @0@ Controls left/right scroll|LCD_ENTRYLEFT -- ^ bit @1@ Controls left/right entry mode-- | Convert the mask value to the bit nomaskBit ::Hitachi44780Mask ->IntmaskBit :: Hitachi44780Mask -> Int
maskBit Hitachi44780Mask
LCD_BLINKON =Int
0maskBit Hitachi44780Mask
LCD_CURSORON =Int
1maskBit Hitachi44780Mask
LCD_DISPLAYON =Int
2maskBit Hitachi44780Mask
LCD_ENTRYSHIFTINCREMENT =Int
0maskBit Hitachi44780Mask
LCD_ENTRYLEFT =Int
1-- | Clear by the maskclearMask ::Hitachi44780Mask ->Word8->Word8clearMask :: Hitachi44780Mask -> Word8 -> Word8
clearMask Hitachi44780Mask
m Word8
w =Word8
w forall a. Bits a => a -> Int -> a
`clearBit`Hitachi44780Mask -> Int
maskBit Hitachi44780Mask
m -- | Set by the masksetMask ::Hitachi44780Mask ->Word8->Word8setMask :: Hitachi44780Mask -> Word8 -> Word8
setMask Hitachi44780Mask
m Word8
w =Word8
w forall a. Bits a => a -> Int -> a
`setBit`Hitachi44780Mask -> Int
maskBit Hitachi44780Mask
m -- | Do not blink the cursorlcdBlinkOff ::LCD ->Arduino ()lcdBlinkOff :: LCD -> Arduino ()
lcdBlinkOff =String -> (Word8 -> Word8) -> LCD -> Arduino ()
updateDisplayControl String
"Turning blinking off"(Hitachi44780Mask -> Word8 -> Word8
clearMask Hitachi44780Mask
LCD_BLINKON )-- | Blink the cursorlcdBlinkOn ::LCD ->Arduino ()lcdBlinkOn :: LCD -> Arduino ()
lcdBlinkOn =String -> (Word8 -> Word8) -> LCD -> Arduino ()
updateDisplayControl String
"Turning blinking on"(Hitachi44780Mask -> Word8 -> Word8
setMask Hitachi44780Mask
LCD_BLINKON )-- | Hide the cursor. Note that a blinking cursor cannot be hidden, you must first-- turn off blinking.lcdCursorOff ::LCD ->Arduino ()lcdCursorOff :: LCD -> Arduino ()
lcdCursorOff =String -> (Word8 -> Word8) -> LCD -> Arduino ()
updateDisplayControl String
"Not showing the cursor"(Hitachi44780Mask -> Word8 -> Word8
clearMask Hitachi44780Mask
LCD_CURSORON )-- | Show the cursorlcdCursorOn ::LCD ->Arduino ()lcdCursorOn :: LCD -> Arduino ()
lcdCursorOn =String -> (Word8 -> Word8) -> LCD -> Arduino ()
updateDisplayControl String
"Showing the cursor"(Hitachi44780Mask -> Word8 -> Word8
setMask Hitachi44780Mask
LCD_CURSORON )-- | Turn the display off. Note that turning the display off does not mean you are-- powering it down. It simply means that the characters will not be shown until-- you turn it back on using 'lcdDisplayOn'. (Also, the contents will /not/ be-- forgotten when you call this function.) Therefore, this function is useful-- for temporarily hiding the display contents.lcdDisplayOff ::LCD ->Arduino ()lcdDisplayOff :: LCD -> Arduino ()
lcdDisplayOff =String -> (Word8 -> Word8) -> LCD -> Arduino ()
updateDisplayControl String
"Turning display off"(Hitachi44780Mask -> Word8 -> Word8
clearMask Hitachi44780Mask
LCD_DISPLAYON )-- | Turn the display onlcdDisplayOn ::LCD ->Arduino ()lcdDisplayOn :: LCD -> Arduino ()
lcdDisplayOn =String -> (Word8 -> Word8) -> LCD -> Arduino ()
updateDisplayControl String
"Turning display on"(Hitachi44780Mask -> Word8 -> Word8
setMask Hitachi44780Mask
LCD_DISPLAYON )-- | Set writing direction: Left to RightlcdLeftToRight ::LCD ->Arduino ()lcdLeftToRight :: LCD -> Arduino ()
lcdLeftToRight =String -> (Word8 -> Word8) -> LCD -> Arduino ()
updateDisplayMode String
"Setting left-to-right entry mode"(Hitachi44780Mask -> Word8 -> Word8
setMask Hitachi44780Mask
LCD_ENTRYLEFT )-- | Set writing direction: Right to LeftlcdRightToLeft ::LCD ->Arduino ()lcdRightToLeft :: LCD -> Arduino ()
lcdRightToLeft =String -> (Word8 -> Word8) -> LCD -> Arduino ()
updateDisplayMode String
"Setting right-to-left entry mode"(Hitachi44780Mask -> Word8 -> Word8
clearMask Hitachi44780Mask
LCD_ENTRYLEFT )-- | Turn on auto-scrolling. In the context of the Hitachi44780 controller, this means that-- each time a letter is added, all the text is moved one space to the left. This can be-- confusing at first: It does /not/ mean that your strings will continuously scroll:-- It just means that if you write a string whose length exceeds the column-count-- of your LCD, then you'll see the tail-end of it. (Of course, this will create a scrolling-- effect as the string is being printed character by character.)---- Having said that, it is easy to program a scrolling string program: Simply write your string-- by calling 'lcdWrite', and then use the 'lcdScrollDisplayLeft' and 'lcdScrollDisplayRight' functions-- with appropriate delays to simulate the scrolling.lcdAutoScrollOn ::LCD ->Arduino ()lcdAutoScrollOn :: LCD -> Arduino ()
lcdAutoScrollOn =String -> (Word8 -> Word8) -> LCD -> Arduino ()
updateDisplayMode String
"Setting auto-scroll ON"(Hitachi44780Mask -> Word8 -> Word8
setMask Hitachi44780Mask
LCD_ENTRYSHIFTINCREMENT )-- | Turn off auto-scrolling. See the comments for 'lcdAutoScrollOn' for details. When turned-- off (which is the default), you will /not/ see the characters at the end of your strings that-- do not fit into the display.lcdAutoScrollOff ::LCD ->Arduino ()lcdAutoScrollOff :: LCD -> Arduino ()
lcdAutoScrollOff =String -> (Word8 -> Word8) -> LCD -> Arduino ()
updateDisplayMode String
"Setting auto-scroll OFF"(Hitachi44780Mask -> Word8 -> Word8
clearMask Hitachi44780Mask
LCD_ENTRYSHIFTINCREMENT )-- | Flash contents of the LCD screenlcdFlash ::LCD ->Int-- ^ Flash count->Int-- ^ Delay amount (in milli-seconds)->Arduino ()lcdFlash :: LCD -> Int -> Int -> Arduino ()
lcdFlash LCD
lcd Int
n Int
d =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 ()
lcdDisplayOff LCD
lcd ,Int -> Arduino ()
delay Int
d ,LCD -> Arduino ()
lcdDisplayOn LCD
lcd ,Int -> Arduino ()
delay Int
d ]-- | An abstract symbol type for user created symbolsnewtypeLCDSymbol =LCDSymbol Word8-- | Create a custom symbol for later display. Note that controllers-- have limited capability for such symbols, typically storing no more-- than 8. The behavior is undefined if you create more symbols than your-- LCD can handle.---- The input is a simple description of the glyph, as a list of precisely 8-- strings, each of which must have 5 characters. Any space character is-- interpreted as a empty pixel, any non-space is a full pixel, corresponding-- to the pixel in the 5x8 characters we have on the LCD. For instance, here's-- a happy-face glyph you can use:---- >-- > [ " "-- > , "@ @"-- > , " "-- > , " "-- > , "@ @"-- > , " @@@ "-- > , " "-- > , " "-- > ]-- >lcdCreateSymbol ::LCD ->[String]->Arduino LCDSymbol lcdCreateSymbol :: LCD -> [String] -> Arduino LCDSymbol
lcdCreateSymbol LCD
lcd [String]
glyph |forall (t :: * -> *) a. Foldable t => t a -> Int
length[String]
glyph forall a. Eq a => a -> a -> Bool
/=Int
8Bool -> Bool -> Bool
||forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any((forall a. Eq a => a -> a -> Bool
/=Int
5)forall b c a. (b -> c) -> (a -> b) -> a -> c
.forall (t :: * -> *) a. Foldable t => t a -> Int
length)[String]
glyph =forall a. String -> [String] -> Arduino a
die String
"hArduino: lcdCreateSymbol: Invalid glyph description: must be 8x5!"(String
"Received:"forall a. a -> [a] -> [a]
:[String]
glyph )|Bool
True=doMVar BoardState
bs <-forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
getsArduinoState -> MVar BoardState
boardState String -> [String] -> IO ()
err <-forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
getsArduinoState -> String -> [String] -> IO ()
bailOut (Word8
i ,LCDController
c )<-forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIOforall a b. (a -> b) -> a -> b
$forall a b. MVar a -> (a -> IO (a, b)) -> IO b
modifyMVarMVar BoardState
bs forall a b. (a -> b) -> a -> b
$\BoardState
bst ->caseLCD
lcd forall k a. Ord k => k -> Map k a -> Maybe a
`M.lookup`BoardState -> Map LCD LCDData
lcds BoardState
bst ofMaybe LCDData
Nothing->doString -> [String] -> IO ()
err (String
"hArduino: Cannot locate "forall a. [a] -> [a] -> [a]
++forall a. Show a => a -> String
showLCD
lcd )[]forall a. IO a
exitFailureJustld :: LCDData
ld @LCDData {Word8
lcdGlyphCount :: Word8
lcdGlyphCount :: LCDData -> Word8
lcdGlyphCount ,LCDController
lcdController :: LCDController
lcdController :: LCDData -> LCDController
lcdController }->doletld' :: LCDData
ld' =LCDData
ld {lcdGlyphCount :: Word8
lcdGlyphCount =Word8
lcdGlyphCount forall a. Num a => a -> a -> a
+Word8
1}forall (m :: * -> *) a. Monad m => a -> m a
return(BoardState
bst {lcds :: Map LCD LCDData
lcds =forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insertLCD
lcd LCDData
ld' (BoardState -> Map LCD LCDData
lcds BoardState
bst )},(Word8
lcdGlyphCount ,LCDController
lcdController ))LCDController -> Cmd -> Arduino ()
sendCmd LCDController
c (Word8 -> Cmd
LCD_SETCGRAMADDR Word8
i )letcvt ::String->Word8cvt :: String -> Word8
cvt String
s =forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldrforall a. Bits a => a -> a -> a
(.|.)Word8
0[forall a. Bits a => Int -> a
bitInt
p |(Char
ch ,Int
p )<-forall a b. [a] -> [b] -> [(a, b)]
zip(forall a. [a] -> [a]
reverseString
s )[Int
0..],Bool -> Bool
not(Char -> Bool
isSpaceChar
ch )]forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_(LCDController -> Word8 -> Arduino ()
sendData LCDController
c forall b c a. (b -> c) -> (a -> b) -> a -> c
.String -> Word8
cvt )[String]
glyph forall (m :: * -> *) a. Monad m => a -> m a
returnforall a b. (a -> b) -> a -> b
$Word8 -> LCDSymbol
LCDSymbol Word8
i -- | Display a user created symbol on the LCD. (See 'lcdCreateSymbol' for details.)lcdWriteSymbol ::LCD ->LCDSymbol ->Arduino ()lcdWriteSymbol :: LCD -> LCDSymbol -> Arduino ()
lcdWriteSymbol LCD
lcd (LCDSymbol Word8
i )=forall a.
LCD -> String -> (LCDController -> Arduino a) -> Arduino a
withLCD LCD
lcd (String
"Writing custom symbol "forall a. [a] -> [a] -> [a]
++forall a. Show a => a -> String
showWord8
i forall a. [a] -> [a] -> [a]
++String
" to LCD")forall a b. (a -> b) -> a -> b
$\LCDController
c ->LCDController -> Word8 -> Arduino ()
sendData LCDController
c Word8
i -- | Access an internally stored symbol, one that is not available via its ASCII equivalent. See-- the Hitachi datasheet for possible values: <http://lcd-linux.sourceforge.net/pdfdocs/hd44780.pdf>, Table 4 on page 17.---- For instance, to access the symbol right-arrow:---- * Locate it in the above table: Right-arrow is at the second-to-last row, 7th character from left.---- * Check the upper/higher bits as specified in the table: For Right-arrow, upper bits are @0111@ and the-- lower bits are @1110@; which gives us the code @01111110@, or @0x7E@.---- * So, right-arrow can be accessed by symbol code 'lcdInternalSymbol' @0x7E@, which will give us a 'LCDSymbol' value-- that can be passed to the 'lcdWriteSymbol' function. The code would look like this: @lcdWriteSymbol lcd (lcdInternalSymbol 0x7E)@.lcdInternalSymbol ::Word8->LCDSymbol lcdInternalSymbol :: Word8 -> LCDSymbol
lcdInternalSymbol =Word8 -> LCDSymbol
LCDSymbol