module System.Hardware.PiLcd.I2c
( I2cHandle
, Segment (..)
, i2cOpen
, i2cTransaction
, i2cReadReg
, i2cWriteReg
, i2cClose
) where
import Control.Applicative
import Control.Monad
import Data.Word
import Foreign.C.Error
import Foreign.C.Types
import Foreign.Marshal.Alloc
import Foreign.Marshal.Array
import Foreign.Ptr
import Foreign.Storable
import System.Posix.IO
import System.Posix.Types
foreign import ccall "sys/ioctl.h ioctl" c_ioctl ::
CInt -> CULong -> Ptr I2cRdwrIoctlData -> IO CInt
type I2cHandle = Fd
data Segment = Read Int
| Write [Word8]
data I2cRdwrIoctlData =
I2cRdwrIoctlData
{ i2c_msgs :: Ptr I2cMsg
, i2c_nmsgs :: Word32
}
instance Storable I2cRdwrIoctlData where
sizeOf _ = (16)
alignment x = alignment (i2c_nmsgs x)
peek x = I2cRdwrIoctlData
<$> (\hsc_ptr -> peekByteOff hsc_ptr 0) x
<*> (\hsc_ptr -> peekByteOff hsc_ptr 8) x
poke p x = do
(\hsc_ptr -> pokeByteOff hsc_ptr 0) p (i2c_msgs x)
(\hsc_ptr -> pokeByteOff hsc_ptr 8) p (i2c_nmsgs x)
data I2cMsg =
I2cMsg
{ i2c_addr :: Word16
, i2c_flags :: Word16
, i2c_len :: Word16
, i2c_buf :: Ptr Word8
}
instance Storable I2cMsg where
sizeOf _ = (16)
alignment x = alignment (i2c_buf x)
peek x = I2cMsg
<$> (\hsc_ptr -> peekByteOff hsc_ptr 0) x
<*> (\hsc_ptr -> peekByteOff hsc_ptr 2) x
<*> (\hsc_ptr -> peekByteOff hsc_ptr 4) x
<*> (\hsc_ptr -> peekByteOff hsc_ptr 8) x
poke p x = do
(\hsc_ptr -> pokeByteOff hsc_ptr 0) p (i2c_addr x)
(\hsc_ptr -> pokeByteOff hsc_ptr 2) p (i2c_flags x)
(\hsc_ptr -> pokeByteOff hsc_ptr 4) p (i2c_len x)
(\hsc_ptr -> pokeByteOff hsc_ptr 8) p (i2c_buf x)
flagRd :: Word16
flagRd = 1
i2cRdwr :: CULong
i2cRdwr = 1799
segLength :: Segment -> Int
segLength (Read n) = n
segLength (Write xs) = length xs
fillOutSegments :: Int -> [Segment] -> Ptr I2cMsg -> Ptr Word8 -> IO ()
fillOutSegments _ [] _ _ = return ()
fillOutSegments addr (seg:segs) segPtr bytePtr = do
let len = segLength seg
msg = I2cMsg
{ i2c_addr = fromIntegral addr
, i2c_flags = case seg of
(Read _) -> flagRd
(Write _) -> 0
, i2c_len = fromIntegral len
, i2c_buf = bytePtr
}
poke segPtr msg
case seg of
(Read _) -> return ()
(Write x) -> pokeArray bytePtr x
fillOutSegments addr segs (advancePtr segPtr 1) (advancePtr bytePtr len)
collectResults :: [Segment] -> Ptr Word8 -> IO [[Word8]]
collectResults [] _ = return []
collectResults ((Read n):segs) bytePtr = do
xs <- peekArray n bytePtr
rest <- collectResults segs (advancePtr bytePtr n)
return $ xs : rest
collectResults ((Write xs):segs) bytePtr =
collectResults segs $ advancePtr bytePtr $ length xs
i2cTransaction :: I2cHandle
-> Int
-> [Segment]
-> IO [[Word8]]
i2cTransaction (Fd fd) addr segs = do
let len = sum $ map segLength segs
nSegs = length segs
allocaArray len $ \bytePtr -> do
allocaArray nSegs $ \segPtr -> do
fillOutSegments addr segs segPtr bytePtr
alloca $ \ioctlPtr -> do
poke ioctlPtr $ I2cRdwrIoctlData segPtr $ fromIntegral nSegs
r <- c_ioctl fd i2cRdwr ioctlPtr
when (r < 0) $ throwErrno "i2cTransaction"
collectResults segs bytePtr
i2cOpen :: Int
-> IO I2cHandle
i2cOpen bus = do
let name = "/dev/i2c-" ++ show bus
openFd name ReadWrite Nothing defaultFileFlags
i2cClose :: I2cHandle -> IO ()
i2cClose = closeFd
i2cReadReg :: I2cHandle
-> Int
-> Word8
-> Int
-> IO [Word8]
i2cReadReg h addr reg len = do
[r] <- i2cTransaction h addr [Write [reg], Read len]
return r
i2cWriteReg :: I2cHandle
-> Int
-> Word8
-> [Word8]
-> IO ()
i2cWriteReg h addr reg d = do
i2cTransaction h addr [Write (reg:d)]
return ()