{-# LANGUAGE NamedFieldPuns #-}
{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
module System.Hardware.Arduino.Parts.LCD(
LCD, LCDController(..), lcdRegister
, lcdClear, lcdWrite
, lcdHome, lcdSetCursor
, lcdAutoScrollOn, lcdAutoScrollOff
, lcdScrollDisplayLeft, lcdScrollDisplayRight
, lcdLeftToRight, lcdRightToLeft
, lcdBlinkOn, lcdBlinkOff
, lcdCursorOn, lcdCursorOff
, lcdDisplayOn, lcdDisplayOff
, LCDSymbol, lcdInternalSymbol, lcdWriteSymbol
, lcdCreateSymbol
, lcdFlash
) where
import Control.Concurrent (modifyMVar, withMVar)
import Control.Monad (when)
import Control.Monad.State (gets, liftIO)
import Data.Bits (testBit, (.|.), (.&.), setBit, clearBit, shiftL, bit)
import Data.Char (ord, isSpace)
import Data.Maybe (fromMaybe)
import Data.Word (Word8)
import qualified Data.Map as M
import System.Hardware.Arduino.Data
import System.Hardware.Arduino.Firmata
import qualified System.Hardware.Arduino.Utils as U
import System.Exit (exitFailure)
data Cmd = 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
getCmdVal :: LCDController -> Cmd -> Word8
getCmdVal :: LCDController -> Cmd -> Word8
getCmdVal Hitachi44780{Int
lcdRows :: LCDController -> Int
lcdRows :: Int
lcdRows, Bool
dotMode5x10 :: LCDController -> Bool
dotMode5x10 :: Bool
dotMode5x10} = Cmd -> Word8
get
where multiLine :: Word8
multiLine
| Int
lcdRows forall a. Ord a => a -> a -> Bool
> Int
1 = Word8
0x08 :: Word8
| Bool
True = Word8
0x00 :: Word8
dotMode :: Word8
dotMode
| Bool
dotMode5x10 = Word8
0x04 :: Word8
| Bool
True = Word8
0x00 :: Word8
displayFunction :: Word8
displayFunction = Word8
multiLine forall a. Bits a => a -> a -> a
.|. Word8
dotMode
get :: Cmd -> Word8
get Cmd
LCD_INITIALIZE = Word8
0x33
get Cmd
LCD_INITIALIZE_END = Word8
0x32
get Cmd
LCD_FUNCTIONSET = Word8
0x20 forall a. Bits a => a -> a -> a
.|. Word8
displayFunction
get (LCD_DISPLAYCONTROL Word8
w) = Word8
0x08 forall a. Bits a => a -> a -> a
.|. Word8
w
get Cmd
LCD_CLEARDISPLAY = Word8
0x01
get (LCD_ENTRYMODESET Word8
w) = Word8
0x04 forall a. Bits a => a -> a -> a
.|. Word8
w
get Cmd
LCD_RETURNHOME = Word8
0x02
get (LCD_SETDDRAMADDR Word8
w) = Word8
0x80 forall a. Bits a => a -> a -> a
.|. Word8
w
get (LCD_CURSORSHIFT Word8
w) = Word8
0x10 forall a. Bits a => a -> a -> a
.|. Word8
0x08 forall a. Bits a => a -> a -> a
.|. Word8
w
get (LCD_SETCGRAMADDR Word8
w) = Word8
0x40 forall a. Bits a => a -> a -> a
.|. Word8
w forall a. Bits a => a -> Int -> a
`shiftL` Int
3
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} = do
String -> 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]
Int -> Arduino ()
delay Int
50
LCDController -> Cmd -> Arduino ()
sendCmd LCDController
c Cmd
LCD_INITIALIZE
Int -> Arduino ()
delay Int
5
LCDController -> 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
getController :: LCD -> Arduino LCDController
getController :: LCD -> Arduino LCDController
getController LCD
lcd = do
MVar BoardState
bs <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ArduinoState -> MVar BoardState
boardState
String -> [String] -> IO ()
err <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ArduinoState -> String -> [String] -> IO ()
bailOut
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a b. MVar a -> (a -> IO b) -> IO b
withMVar MVar BoardState
bs forall a b. (a -> b) -> a -> b
$ \BoardState
bst -> case LCD
lcd forall k a. Ord k => k -> Map k a -> Maybe a
`M.lookup` BoardState -> Map LCD LCDData
lcds BoardState
bst of
Maybe LCDData
Nothing -> do String -> [String] -> IO ()
err (String
"hArduino: Cannot locate " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show LCD
lcd) []
forall a. IO a
exitFailure
Just LCDData
ld -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ LCDData -> LCDController
lcdController LCDData
ld
sendCmd :: LCDController -> Cmd -> Arduino ()
sendCmd :: LCDController -> Cmd -> Arduino ()
sendCmd LCDController
c = Bool -> LCDController -> Word8 -> Arduino ()
transmit Bool
False LCDController
c forall b c a. (b -> c) -> (a -> b) -> a -> c
. LCDController -> Cmd -> Word8
getCmdVal LCDController
c
sendData :: LCDController -> Word8 -> Arduino ()
sendData :: LCDController -> Word8 -> Arduino ()
sendData LCDController
lcd Word8
n = do String -> 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
True LCDController
lcd Word8
n
pulseEnable :: LCDController -> Arduino ()
pulseEnable :: LCDController -> Arduino ()
pulseEnable Hitachi44780{Pin
lcdEN :: Pin
lcdEN :: LCDController -> Pin
lcdEN} = do
String -> Arduino ()
debug String
"Sending LCD pulseEnable"
Pin -> Bool -> Arduino ()
digitalWrite Pin
lcdEN Bool
False
Int -> Arduino ()
delay Int
1
Pin -> Bool -> Arduino ()
digitalWrite Pin
lcdEN Bool
True
Int -> Arduino ()
delay Int
1
Pin -> Bool -> Arduino ()
digitalWrite Pin
lcdEN Bool
False
Int -> Arduino ()
delay Int
1
transmit :: 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 = do
Pin -> Bool -> Arduino ()
digitalWrite Pin
lcdRS Bool
mode
Pin -> Bool -> Arduino ()
digitalWrite Pin
lcdEN Bool
False
let [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]]
Pin -> 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
Pin -> 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
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 = do
String -> Arduino ()
debug String
what
LCDController
c <- LCD -> Arduino LCDController
getController LCD
lcd
LCDController -> Arduino a
action LCDController
c
lcdRegister :: LCDController -> Arduino LCD
lcdRegister :: LCDController -> Arduino LCD
lcdRegister LCDController
controller = do
MVar BoardState
bs <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ArduinoState -> MVar BoardState
boardState
LCD
lcd <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a b. MVar a -> (a -> IO (a, b)) -> IO b
modifyMVar MVar BoardState
bs forall a b. (a -> b) -> a -> b
$ \BoardState
bst -> do
let n :: Int
n = forall k a. Map k a -> Int
M.size forall 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)
case LCDController
controller of
Hitachi44780{} -> LCD -> LCDController -> Arduino ()
initLCD LCD
lcd LCDController
controller
forall (m :: * -> *) a. Monad m => a -> m a
return LCD
lcd
lcdWrite :: 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
show String
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'
where m' :: [Word8]
m' = forall a b. (a -> b) -> [a] -> [b]
map (\Char
ch -> forall a b. (Integral a, Num b) => a -> b
fromIntegral (Char -> Int
ord Char
ch) forall a. Bits a => a -> a -> a
.&. Word8
0xFF) String
m
lcdClear :: 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 ->
do LCDController -> Cmd -> Arduino ()
sendCmd LCDController
c Cmd
LCD_CLEARDISPLAY
Int -> Arduino ()
delay Int
2
lcdHome :: 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 ->
do LCDController -> Cmd -> Arduino ()
sendCmd LCDController
c Cmd
LCD_RETURNHOME
Int -> Arduino ()
delay Int
2
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
show Int
givenRow forall a. [a] -> [a] -> [a]
++ String
" Col: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
givenCol) LCDController -> Arduino ()
set
where set :: 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)
where align :: Int -> Int -> Word8
align :: 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
fromIntegral forall a b. (a -> b) -> a -> b
$ Int
mforall a. Num a => a -> a -> a
-Int
1
| Bool
True = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i
col :: Word8
col = Int -> Int -> Word8
align Int
givenCol Int
lcdCols
row :: Word8
row = Int -> Int -> Word8
align Int
givenRow Int
lcdRows
rowOffsets :: [(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
fromMaybe Word8
0x54 (Word8
row forall a b. Eq a => a -> [(a, b)] -> Maybe b
`lookup` [(Word8, Word8)]
rowOffsets)
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)
where lcdMoveLeft :: Word8
lcdMoveLeft = Word8
0x00
lcdScrollDisplayRight :: 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)
where lcdMoveRight :: Word8
lcdMoveRight = Word8
0x04
updateDisplayData :: 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 = do
String -> Arduino ()
debug String
what
MVar BoardState
bs <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ArduinoState -> MVar BoardState
boardState
String -> [String] -> IO ()
err <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ArduinoState -> 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
liftIO forall a b. (a -> b) -> a -> b
$ forall a b. MVar a -> (a -> IO (a, b)) -> IO b
modifyMVar MVar BoardState
bs forall a b. (a -> b) -> a -> b
$ \BoardState
bst ->
case LCD
lcd forall k a. Ord k => k -> Map k a -> Maybe a
`M.lookup` BoardState -> Map LCD LCDData
lcds BoardState
bst of
Maybe LCDData
Nothing -> do String -> [String] -> IO ()
err (String
"hArduino: Cannot locate " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show LCD
lcd) []
forall a. IO a
exitFailure
Just ld :: LCDData
ld@LCDData{Word8
lcdDisplayControl :: Word8
lcdDisplayControl :: LCDData -> Word8
lcdDisplayControl, Word8
lcdDisplayMode :: Word8
lcdDisplayMode :: LCDData -> Word8
lcdDisplayMode}
-> do let ld' :: 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.insert LCD
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)
updateDisplayControl :: 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)
updateDisplayMode :: 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)
data Hitachi44780Mask = LCD_BLINKON
| LCD_CURSORON
| LCD_DISPLAYON
| LCD_ENTRYSHIFTINCREMENT
| LCD_ENTRYLEFT
maskBit :: Hitachi44780Mask -> Int
maskBit :: Hitachi44780Mask -> Int
maskBit Hitachi44780Mask
LCD_BLINKON = Int
0
maskBit Hitachi44780Mask
LCD_CURSORON = Int
1
maskBit Hitachi44780Mask
LCD_DISPLAYON = Int
2
maskBit Hitachi44780Mask
LCD_ENTRYSHIFTINCREMENT = Int
0
maskBit Hitachi44780Mask
LCD_ENTRYLEFT = Int
1
clearMask :: Hitachi44780Mask -> Word8 -> Word8
clearMask :: Hitachi44780Mask -> Word8 -> Word8
clearMask Hitachi44780Mask
m Word8
w = Word8
w forall a. Bits a => a -> Int -> a
`clearBit` Hitachi44780Mask -> Int
maskBit Hitachi44780Mask
m
setMask :: Hitachi44780Mask -> Word8 -> Word8
setMask :: Hitachi44780Mask -> Word8 -> Word8
setMask Hitachi44780Mask
m Word8
w = Word8
w forall a. Bits a => a -> Int -> a
`setBit` Hitachi44780Mask -> Int
maskBit Hitachi44780Mask
m
lcdBlinkOff :: LCD -> Arduino ()
lcdBlinkOff :: LCD -> Arduino ()
lcdBlinkOff = String -> (Word8 -> Word8) -> LCD -> Arduino ()
updateDisplayControl String
"Turning blinking off" (Hitachi44780Mask -> Word8 -> Word8
clearMask Hitachi44780Mask
LCD_BLINKON)
lcdBlinkOn :: LCD -> Arduino ()
lcdBlinkOn :: LCD -> Arduino ()
lcdBlinkOn = String -> (Word8 -> Word8) -> LCD -> Arduino ()
updateDisplayControl String
"Turning blinking on" (Hitachi44780Mask -> Word8 -> Word8
setMask Hitachi44780Mask
LCD_BLINKON)
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)
lcdCursorOn :: LCD -> Arduino ()
lcdCursorOn :: LCD -> Arduino ()
lcdCursorOn = String -> (Word8 -> Word8) -> LCD -> Arduino ()
updateDisplayControl String
"Showing the cursor" (Hitachi44780Mask -> Word8 -> Word8
setMask Hitachi44780Mask
LCD_CURSORON)
lcdDisplayOff :: LCD -> Arduino ()
lcdDisplayOff :: LCD -> Arduino ()
lcdDisplayOff = String -> (Word8 -> Word8) -> LCD -> Arduino ()
updateDisplayControl String
"Turning display off" (Hitachi44780Mask -> Word8 -> Word8
clearMask Hitachi44780Mask
LCD_DISPLAYON)
lcdDisplayOn :: LCD -> Arduino ()
lcdDisplayOn :: LCD -> Arduino ()
lcdDisplayOn = String -> (Word8 -> Word8) -> LCD -> Arduino ()
updateDisplayControl String
"Turning display on" (Hitachi44780Mask -> Word8 -> Word8
setMask Hitachi44780Mask
LCD_DISPLAYON)
lcdLeftToRight :: 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)
lcdRightToLeft :: 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)
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)
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)
lcdFlash :: LCD
-> Int
-> Int
-> 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]
concat forall a b. (a -> b) -> a -> b
$ forall a. Int -> a -> [a]
replicate Int
n [LCD -> Arduino ()
lcdDisplayOff LCD
lcd, Int -> Arduino ()
delay Int
d, LCD -> Arduino ()
lcdDisplayOn LCD
lcd, Int -> Arduino ()
delay Int
d]
newtype LCDSymbol = LCDSymbol Word8
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
8 Bool -> 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
= do MVar BoardState
bs <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ArduinoState -> MVar BoardState
boardState
String -> [String] -> IO ()
err <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ArduinoState -> String -> [String] -> IO ()
bailOut
(Word8
i, LCDController
c) <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a b. MVar a -> (a -> IO (a, b)) -> IO b
modifyMVar MVar BoardState
bs forall a b. (a -> b) -> a -> b
$ \BoardState
bst ->
case LCD
lcd forall k a. Ord k => k -> Map k a -> Maybe a
`M.lookup` BoardState -> Map LCD LCDData
lcds BoardState
bst of
Maybe LCDData
Nothing -> do String -> [String] -> IO ()
err (String
"hArduino: Cannot locate " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show LCD
lcd) []
forall a. IO a
exitFailure
Just ld :: LCDData
ld@LCDData{Word8
lcdGlyphCount :: Word8
lcdGlyphCount :: LCDData -> Word8
lcdGlyphCount, LCDController
lcdController :: LCDController
lcdController :: LCDData -> LCDController
lcdController}
-> do let ld' :: 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.insert LCD
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)
let cvt :: String -> Word8
cvt :: String -> Word8
cvt String
s = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall a. Bits a => a -> a -> a
(.|.) Word8
0 [forall a. Bits a => Int -> a
bit Int
p | (Char
ch, Int
p) <- forall a b. [a] -> [b] -> [(a, b)]
zip (forall a. [a] -> [a]
reverse String
s) [Int
0..], Bool -> Bool
not (Char -> Bool
isSpace Char
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
return forall a b. (a -> b) -> a -> b
$ Word8 -> LCDSymbol
LCDSymbol Word8
i
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
show Word8
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
lcdInternalSymbol :: Word8 -> LCDSymbol
lcdInternalSymbol :: Word8 -> LCDSymbol
lcdInternalSymbol = Word8 -> LCDSymbol
LCDSymbol