module Hardware.LCD.CFA635(
LCD
, withLCD
, open
, close
, contrast
, backlight
, cursorStyle
, clear
, Pos(..)
, move
, write
, setLED
, clearLEDs) where
import Data.Word
import Data.List
import Data.Bits
import Control.Monad
import Control.Monad.Maybe
import qualified System.Hardware.Serialport as Ser
import qualified Data.Digest.Table.CRC16 as CRC
import qualified Control.Exception as Exn
clamp :: (Ord a) => String -> a -> a -> a -> a
clamp fun lb ub x
| (x >= lb) && (x <= ub) = x
| otherwise = error ("CFA635." ++ fun ++ ": argument out of bounds")
data LCD = LCD
{ lcdPort :: Ser.SerialPort
, lcdWidth :: Int
, lcdHeight :: Int }
data Pos = Pos Int Int
deriving (Eq, Show)
pClamp :: String -> LCD -> Pos -> Pos
pClamp fun LCD{lcdWidth,lcdHeight}
(Pos (clamp fun 0 (lcdWidth 1) -> col)
(clamp fun 0 (lcdHeight1) -> row)) = Pos col row
i8 :: Int -> Word8
i8 = fromIntegral
portSettings :: Ser.SerialPortSettings
portSettings = Ser.SerialPortSettings {
baudRate = Ser.B115200,
bitsPerWord = 8,
stopb = Ser.One,
parity = Ser.NoParity,
flowControl = Ser.NoFlowControl,
timeout = 1 }
open :: FilePath -> IO LCD
open portName = do
p <- Ser.openSerial portName portSettings
let x = LCD p 20 4
clear x
clearLEDs x
return x
close :: LCD -> IO ()
close LCD{lcdPort} = Ser.closeSerial lcdPort
withLCD :: FilePath -> (LCD -> IO a) -> IO a
withLCD f = Exn.bracket (open f) close
data Pkt = Pkt Word8 [Word8]
deriving (Show)
clear :: LCD -> IO ()
clear p = sendPkt p $ Pkt 0x06 []
contrast :: LCD -> Int -> IO ()
contrast p (clamp "contrast" 0 254 -> x)
= sendPkt p $ Pkt 0x0D [i8 x]
backlight :: LCD -> Int -> IO ()
backlight p (clamp "backlight" 0 100 -> x)
= sendPkt p $ Pkt 0x0E [i8 x]
setLED :: LCD -> Int -> Bool -> IO ()
setLED p (clamp "setLED" 0 7 -> i) st
= sendPkt p $ Pkt 0x22 [i8 (5+i), if st then 100 else 0]
clearLEDs :: LCD -> IO ()
clearLEDs p = forM_ [0..7] $ \i -> setLED p i False
cursorStyle :: LCD -> Int -> IO ()
cursorStyle p (clamp "cursorStyle" 0 4 -> i) = sendPkt p $ Pkt 0x0C [i8 i]
encode :: String -> [Word8]
encode = map ec where
ec x = case fromEnum x of
i | i > 127 -> 187
| otherwise -> fromIntegral i
write :: LCD -> Pos -> String -> IO ()
write
p@LCD{lcdWidth}
(pClamp "write" p -> Pos col row)
xs
= sendPkt p $ Pkt 0x1F (i8 col : i8 row : encode pxs) where
pxs = take (lcdWidthcol) xs
move :: LCD -> Pos -> IO ()
move p (pClamp "write" p -> Pos col row)
= sendPkt p $ Pkt 0x0B [i8 col, i8 row]
sendI :: (Integral a) => Ser.SerialPort -> a -> IO ()
sendI p = Ser.sendChar p . toEnum . fromIntegral
send8 :: Ser.SerialPort -> Word8 -> IO ()
send8 = sendI
send16 :: Ser.SerialPort -> Word16 -> IO ()
send16 p n = do
sendI p (n .&. 0xFF)
sendI p (n `shiftR` 8)
sendPkt1 :: LCD -> Pkt -> IO ()
sendPkt1 LCD{lcdPort=p} (Pkt ty dat) = do
send8 p ty
let lenb = genericLength dat
send8 p lenb
mapM_ (send8 p) dat
send16 p $ CRC.crc16 (ty:lenb:dat)
sendPkt :: LCD -> Pkt -> IO ()
sendPkt l p = do
sendPkt1 l p
_ <- recvPkt l
return ()
recv8 :: Ser.SerialPort -> IO (Maybe Word8)
recv8 = fmap (fmap (fromIntegral . fromEnum)) . Ser.recvChar
trecv16 :: Ser.SerialPort -> MaybeT IO Word16
trecv16 p = do
l <- trecv8 p
h <- trecv8 p
return (fromIntegral l .|. (fromIntegral h `shiftL` 8))
trecv8 :: Ser.SerialPort -> MaybeT IO Word8
trecv8 = MaybeT . recv8
recvPkt :: LCD -> IO (Maybe Pkt)
recvPkt LCD{lcdPort=p} = runMaybeT $ do
typ <- trecv8 p
len <- trecv8 p
dat <- replicateM (fromIntegral len) $ trecv8 p
cs <- trecv16 p
when (CRC.crc16 (typ:len:dat) /= cs) $
fail "bad crc"
return (Pkt typ dat)