-------------------------------------------------------------------------------------------------
-- |
-- 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 #-}

module System.Hardware.Arduino.Parts.LCD(
  -- * LCD types and registration
  LCD, 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
  )  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)

---------------------------------------------------------------------------------------
-- Low level interface, not available to the user
---------------------------------------------------------------------------------------

-- | Commands understood by Hitachi
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

-- | Convert a command to a data-word
getCmdVal :: LCDController -> Cmd -> Word8
getCmdVal :: LCDController -> Cmd -> Word8
getCmdVal Hitachi44780{Int
lcdRows :: Int
lcdRows :: LCDController -> Int
lcdRows, Bool
dotMode5x10 :: Bool
dotMode5x10 :: LCDController -> Bool
dotMode5x10} = Cmd -> Word8
get
  where multiLine :: Word8
multiLine -- bit 3
          | Int
lcdRows Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1 = Word8
0x08 :: Word8
          | Bool
True        = Word8
0x00 :: Word8
        dotMode :: Word8
dotMode   -- bit 2
          | Bool
dotMode5x10 = Word8
0x04 :: Word8
          | Bool
True        = Word8
0x00 :: Word8
        displayFunction :: Word8
displayFunction = Word8
multiLine Word8 -> Word8 -> Word8
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 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Word8
displayFunction
        get (LCD_DISPLAYCONTROL Word8
w) = Word8
0x08 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Word8
w
        get Cmd
LCD_CLEARDISPLAY       = Word8
0x01
        get (LCD_ENTRYMODESET Word8
w)   = Word8
0x04 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Word8
w
        get Cmd
LCD_RETURNHOME         = Word8
0x02
        get (LCD_SETDDRAMADDR Word8
w)   = Word8
0x80 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Word8
w
        get (LCD_CURSORSHIFT Word8
w)    = Word8
0x10 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Word8
0x08 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Word8
w   -- NB. LCD_DISPLAYMOVE (0x08) hard coded here
        get (LCD_SETCGRAMADDR Word8
w)   = Word8
0x40 Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.|. Word8
w Word8 -> Int -> Word8
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 :: 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} = do
    String -> Arduino ()
debug String
"Starting the LCD initialization sequence"
    (Pin -> Arduino ()) -> [Pin] -> Arduino ()
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 safe
    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

-- | Get the controller associated with the LCD
getController :: LCD -> Arduino LCDController
getController :: LCD -> Arduino LCDController
getController LCD
lcd = do
  bs  <- (ArduinoState -> MVar BoardState) -> Arduino (MVar BoardState)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ArduinoState -> MVar BoardState
boardState
  err <- gets bailOut
  liftIO $ withMVar bs $ \BoardState
bst -> case LCD
lcd LCD -> Map LCD LCDData -> Maybe LCDData
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 " String -> String -> String
forall a. [a] -> [a] -> [a]
++ LCD -> String
forall a. Show a => a -> String
show LCD
lcd) []
                                                 IO LCDController
forall a. IO a
exitFailure
                                   Just LCDData
ld -> LCDController -> IO LCDController
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (LCDController -> IO LCDController)
-> LCDController -> IO LCDController
forall a b. (a -> b) -> a -> b
$ LCDData -> LCDController
lcdController LCDData
ld

-- | Send a command to the LCD controller
sendCmd :: LCDController -> Cmd -> Arduino ()
sendCmd :: LCDController -> Cmd -> Arduino ()
sendCmd LCDController
c = Bool -> LCDController -> Word8 -> Arduino ()
transmit Bool
False LCDController
c (Word8 -> Arduino ()) -> (Cmd -> Word8) -> Cmd -> Arduino ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LCDController -> Cmd -> Word8
getCmdVal LCDController
c

-- | Send 4-bit data to the LCD controller
sendData :: LCDController -> Word8 -> Arduino ()
sendData :: LCDController -> Word8 -> Arduino ()
sendData LCDController
lcd Word8
n = do String -> Arduino ()
debug (String -> Arduino ()) -> String -> Arduino ()
forall a b. (a -> b) -> a -> b
$ String
"Transmitting LCD data: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word8 -> String
U.showByte Word8
n
                    Bool -> LCDController -> Word8 -> Arduino ()
transmit Bool
True LCDController
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 :: LCDController -> Pin
lcdEN :: 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 data down to the LCD
transmit :: Bool -> LCDController -> Word8 -> Arduino ()
transmit :: Bool -> LCDController -> Word8 -> Arduino ()
transmit Bool
mode 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} 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 Word8 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
`testBit` Int
i | Int
i <- [Int
7, Int
6 .. Int
0]]
  -- Send down the first 4 bits
  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
  -- Send down the remaining batch
  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

-- | 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 = do
        String -> Arduino ()
debug String
what
        c <- LCD -> Arduino LCDController
getController LCD
lcd
        action 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 = do
  bs <- (ArduinoState -> MVar BoardState) -> Arduino (MVar BoardState)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ArduinoState -> MVar BoardState
boardState
  lcd <- liftIO $ modifyMVar bs $ \BoardState
bst -> do
                    let n :: Int
n = Map LCD LCDData -> Int
forall k a. Map k a -> Int
M.size (Map LCD LCDData -> Int) -> Map LCD LCDData -> Int
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
                                     }
                    (BoardState, LCD) -> IO (BoardState, LCD)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (BoardState
bst {lcds = M.insert (LCD n) ld (lcds bst)}, Int -> LCD
LCD Int
n)
  case controller of
     Hitachi44780{} -> LCD -> LCDController -> Arduino ()
initLCD LCD
lcd LCDController
controller
  return lcd

-- | Write a string on the LCD at the current cursor position
lcdWrite :: LCD -> String -> Arduino ()
lcdWrite :: LCD -> String -> Arduino ()
lcdWrite LCD
lcd String
m = LCD -> String -> (LCDController -> Arduino ()) -> Arduino ()
forall a.
LCD -> String -> (LCDController -> Arduino a) -> Arduino a
withLCD LCD
lcd (String
"Writing " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
m String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" to LCD") ((LCDController -> Arduino ()) -> Arduino ())
-> (LCDController -> Arduino ()) -> Arduino ()
forall a b. (a -> b) -> a -> b
$ \LCDController
c -> (Word8 -> Arduino ()) -> [Word8] -> Arduino ()
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' = (Char -> Word8) -> String -> [Word8]
forall a b. (a -> b) -> [a] -> [b]
map (\Char
ch -> Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Char -> Int
ord Char
ch) Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0xFF) String
m

-- | Clear the LCD
lcdClear :: LCD -> Arduino ()
lcdClear :: LCD -> Arduino ()
lcdClear LCD
lcd = LCD -> String -> (LCDController -> Arduino ()) -> Arduino ()
forall a.
LCD -> String -> (LCDController -> Arduino a) -> Arduino a
withLCD LCD
lcd String
"Sending clearLCD" ((LCDController -> Arduino ()) -> Arduino ())
-> (LCDController -> Arduino ()) -> Arduino ()
forall a b. (a -> b) -> a -> b
$ \LCDController
c ->
                 do LCDController -> 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 position
lcdHome :: LCD -> Arduino ()
lcdHome :: LCD -> Arduino ()
lcdHome LCD
lcd = LCD -> String -> (LCDController -> Arduino ()) -> Arduino ()
forall a.
LCD -> String -> (LCDController -> Arduino a) -> Arduino a
withLCD LCD
lcd String
"Sending the cursor home" ((LCDController -> Arduino ()) -> Arduino ())
-> (LCDController -> Arduino ()) -> Arduino ()
forall a b. (a -> b) -> a -> b
$ \LCDController
c ->
                do LCDController -> 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) = LCD -> String -> (LCDController -> Arduino ()) -> Arduino ()
forall a.
LCD -> String -> (LCDController -> Arduino a) -> Arduino a
withLCD LCD
lcd (String
"Sending the cursor to Row: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
givenRow String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" Col: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
givenCol) LCDController -> Arduino ()
set
  where set :: LCDController -> Arduino ()
set c :: LCDController
c@Hitachi44780{Int
lcdRows :: LCDController -> Int
lcdRows :: Int
lcdRows, Int
lcdCols :: Int
lcdCols :: LCDController -> 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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0  = Word8
0
                      | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
m = Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> Int -> Word8
forall a b. (a -> b) -> a -> b
$ Int
mInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1
                      | Bool
True   = Int -> Word8
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
                    -- The magic row-offsets come from various web sources
                    -- I don't follow the logic in these numbers, but it seems to work
                    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 Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ Word8 -> Maybe Word8 -> Word8
forall a. a -> Maybe a -> a
fromMaybe Word8
0x54 (Word8
row Word8 -> [(Word8, Word8)] -> Maybe Word8
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 = LCD -> String -> (LCDController -> Arduino ()) -> Arduino ()
forall a.
LCD -> String -> (LCDController -> Arduino a) -> Arduino a
withLCD LCD
lcd String
"Scrolling display to the left by 1" ((LCDController -> Arduino ()) -> Arduino ())
-> (LCDController -> Arduino ()) -> Arduino ()
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

-- | Scroll the display to the right by 1 character
lcdScrollDisplayRight :: LCD -> Arduino ()
lcdScrollDisplayRight :: LCD -> Arduino ()
lcdScrollDisplayRight LCD
lcd = LCD -> String -> (LCDController -> Arduino ()) -> Arduino ()
forall a.
LCD -> String -> (LCDController -> Arduino a) -> Arduino a
withLCD LCD
lcd String
"Scrolling display to the right by 1" ((LCDController -> Arduino ()) -> Arduino ())
-> (LCDController -> Arduino ()) -> Arduino ()
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

-- | Display characteristics helper, set the new control/mode and send
-- appropriate commands if anything changed
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
   bs  <- (ArduinoState -> MVar BoardState) -> Arduino (MVar BoardState)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ArduinoState -> MVar BoardState
boardState
   err <- gets bailOut
   (  LCDData {lcdDisplayControl = oldC, lcdDisplayMode = oldM}
    , LCDData {lcdDisplayControl = newC, lcdDisplayMode = newM, lcdController = c})
        <- liftIO $ modifyMVar bs $ \BoardState
bst ->
                       case LCD
lcd LCD -> Map LCD LCDData -> Maybe LCDData
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 " String -> String -> String
forall a. [a] -> [a] -> [a]
++ LCD -> String
forall a. Show a => a -> String
show LCD
lcd) []
                                       IO (BoardState, (LCDData, LCDData))
forall a. IO a
exitFailure
                         Just ld :: LCDData
ld@LCDData{Word8
lcdDisplayControl :: LCDData -> Word8
lcdDisplayControl :: Word8
lcdDisplayControl, Word8
lcdDisplayMode :: LCDData -> Word8
lcdDisplayMode :: Word8
lcdDisplayMode}
                            -> do let ld' :: LCDData
ld' = LCDData
ld { lcdDisplayControl = f lcdDisplayControl
                                               , lcdDisplayMode    = g lcdDisplayMode
                                               }
                                  (BoardState, (LCDData, LCDData))
-> IO (BoardState, (LCDData, LCDData))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (BoardState
bst{lcds = M.insert lcd ld' (lcds bst)}, (LCDData
ld, LCDData
ld'))
   when (oldC /= newC) $ sendCmd c (LCD_DISPLAYCONTROL newC)
   when (oldM /= newM) $ sendCmd c (LCD_ENTRYMODESET   newM)

-- | Update the display control word
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, Word8 -> Word8
forall a. a -> a
id)

-- | Update the display mode word
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 (Word8 -> Word8
forall a. a -> a
id, Word8 -> Word8
g)

-- | Various control masks for the Hitachi44780
data Hitachi44780Mask = 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 no
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

-- | Clear by the mask
clearMask :: Hitachi44780Mask -> Word8 -> Word8
clearMask :: Hitachi44780Mask -> Word8 -> Word8
clearMask Hitachi44780Mask
m Word8
w = Word8
w Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`clearBit` Hitachi44780Mask -> Int
maskBit Hitachi44780Mask
m

-- | Set by the mask
setMask :: Hitachi44780Mask -> Word8 -> Word8
setMask :: Hitachi44780Mask -> Word8 -> Word8
setMask Hitachi44780Mask
m Word8
w = Word8
w Word8 -> Int -> Word8
forall a. Bits a => a -> Int -> a
`setBit` Hitachi44780Mask -> Int
maskBit Hitachi44780Mask
m

-- | Do not blink the cursor
lcdBlinkOff :: 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 cursor
lcdBlinkOn :: 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 cursor
lcdCursorOn :: 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 on
lcdDisplayOn :: 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 Right
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)

-- | Set writing direction: Right to Left
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)

-- | 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 screen
lcdFlash :: LCD
         -> Int  -- ^ Flash count
         -> Int  -- ^ Delay amount (in milli-seconds)
         -> Arduino ()
lcdFlash :: LCD -> Int -> Int -> Arduino ()
lcdFlash LCD
lcd Int
n Int
d = [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 ()
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 symbols
newtype LCDSymbol = 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
  | [String] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
glyph Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
8 Bool -> Bool -> Bool
|| (String -> Bool) -> [String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
5) (Int -> Bool) -> (String -> Int) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length) [String]
glyph
  = String -> [String] -> Arduino LCDSymbol
forall a. String -> [String] -> Arduino a
die String
"hArduino: lcdCreateSymbol: Invalid glyph description: must be 8x5!" (String
"Received:" String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
glyph)
  | Bool
True
  = do bs  <- (ArduinoState -> MVar BoardState) -> Arduino (MVar BoardState)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ArduinoState -> MVar BoardState
boardState
       err <- gets bailOut
       (i, c) <- liftIO $ modifyMVar bs $ \BoardState
bst ->
                    case LCD
lcd LCD -> Map LCD LCDData -> Maybe LCDData
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 " String -> String -> String
forall a. [a] -> [a] -> [a]
++ LCD -> String
forall a. Show a => a -> String
show LCD
lcd) []
                                    IO (BoardState, (Word8, LCDController))
forall a. IO a
exitFailure
                      Just ld :: LCDData
ld@LCDData{Word8
lcdGlyphCount :: LCDData -> Word8
lcdGlyphCount :: Word8
lcdGlyphCount, LCDController
lcdController :: LCDData -> LCDController
lcdController :: LCDController
lcdController}
                              -> do let ld' :: LCDData
ld' = LCDData
ld { lcdGlyphCount = lcdGlyphCount + 1 }
                                    (BoardState, (Word8, LCDController))
-> IO (BoardState, (Word8, LCDController))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (BoardState
bst{lcds = M.insert lcd ld' (lcds bst)}, (Word8
lcdGlyphCount, LCDController
lcdController))
       sendCmd c (LCD_SETCGRAMADDR i)
       let cvt :: String -> Word8
           cvt String
s = (Word8 -> Word8 -> Word8) -> Word8 -> [Word8] -> Word8
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
(.|.) Word8
0 [Int -> Word8
forall a. Bits a => Int -> a
bit Int
p | (Char
ch, Int
p) <- String -> [Int] -> [(Char, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip (String -> String
forall a. [a] -> [a]
reverse String
s) [Int
0..], Bool -> Bool
not (Char -> Bool
isSpace Char
ch)]
       mapM_ (sendData c . cvt) glyph
       return $ LCDSymbol 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) = LCD -> String -> (LCDController -> Arduino ()) -> Arduino ()
forall a.
LCD -> String -> (LCDController -> Arduino a) -> Arduino a
withLCD LCD
lcd (String
"Writing custom symbol " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word8 -> String
forall a. Show a => a -> String
show Word8
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" to LCD") ((LCDController -> Arduino ()) -> Arduino ())
-> (LCDController -> Arduino ()) -> Arduino ()
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