module System.Hardware.PiLcd.Hd44780
( LcdBus (..)
, LcdCallbacks (..)
, lcdInitialize
, lcdClear
, lcdControl
, lcdWrite
, lcdDefineChar
) where
import Control.Applicative
import Control.Concurrent
import Control.Monad
import Data.Bits
import qualified Data.ByteString as B
import Data.Word
import System.Clock
import System.Hardware.PiLcd.Util
getNanos :: IO Integer
getNanos = toNanoSecs <$> getTime Monotonic
spin :: Int -> IO ()
spin nanos = do
start <- getNanos
let end = start + fromIntegral nanos
sp = do
now <- getNanos
when (now < end) sp
sp
data LcdBus =
LcdBus
{ lbRS :: !Bool
, lbE :: !Bool
, lbDB :: !Word8
} deriving (Eq, Ord, Show, Read)
instReg = False
dataReg = True
newtype LcdCallbacks =
LcdCallbacks
{ lcSend :: LcdBus -> IO ()
}
write4 :: LcdCallbacks -> Bool -> Word8 -> IO ()
write4 cb rs db = do
let bus = LcdBus
{ lbRS = rs
, lbE = False
, lbDB = db
}
lcSend cb $ bus { lbE = True }
lcSend cb $ bus { lbE = False }
write8 :: LcdCallbacks -> Bool -> Word8 -> IO ()
write8 cb rs db = do
write4 cb rs (db `shiftR` 4)
write4 cb rs (db .&. 0xf)
spin 37000
lcdInitialize :: LcdCallbacks -> IO ()
lcdInitialize cb = do
write4 cb instReg 3
threadDelay 4100
write4 cb instReg 3
threadDelay 100
write4 cb instReg 3
spin 37000
write4 cb instReg 2
spin 37000
doCmd cb 0x28
lcdControl cb False False False
lcdClear cb
lcdMode cb True False
lcdControl cb True False False
doCmd :: LcdCallbacks -> Word8 -> IO ()
doCmd cb cmd = do
write8 cb instReg cmd
doData :: LcdCallbacks -> Word8 -> IO ()
doData cb cmd = do
write8 cb dataReg cmd
lcdClear :: LcdCallbacks -> IO ()
lcdClear cb = do
doCmd cb (bit 0)
threadDelay 1520
lcdControl :: LcdCallbacks
-> Bool
-> Bool
-> Bool
-> IO ()
lcdControl cb d c b =
doCmd cb (bit 3 +
bitIf d 2 +
bitIf c 1 +
bitIf b 0)
lcdMode :: LcdCallbacks -> Bool -> Bool -> IO ()
lcdMode cb id s =
doCmd cb (bit 2 +
bitIf id 1 +
bitIf s 0)
lcdWrite :: LcdCallbacks
-> Word8
-> Word8
-> B.ByteString
-> IO ()
lcdWrite cb line col bs = do
let pos = col + line * 0x40
doCmd cb (0x80 .|. pos)
forM_ (B.unpack bs) $ \b -> doData cb b
lcdDefineChar :: LcdCallbacks
-> Word8
-> [Word8]
-> IO ()
lcdDefineChar cb c bitmap = do
when (c >= 8) $
fail $ "lcdDefineChar: character must be between 0-7; got " ++ show c
let len = length bitmap
when (len /= 8) $
fail $ "lcdDefineChar: bitmap must have 8 elements; got " ++ show len
let pos = c * 8
doCmd cb (0x40 .|. pos)
forM_ bitmap $ \b -> doData cb b