module PowerMate (
PowerMate,
Event(..),
Status(..),
statusInit,
searchForDevice,
openDevice,
readEvent,
writeStatus,
closeDevice
) where
import Foreign
import Foreign.C.Error (throwErrnoIf)
import Foreign.C.Types
import System.Posix.Types (Fd (..))
import System.Posix.IO
import System.IO
import Data.List (isPrefixOf)
import Control.Monad (filterM, when)
import Control.Exception (bracket)
import System.Directory (getDirectoryContents)
import Foreign.C.String (withCAString, peekCString)
import Debug.Trace (trace)
import Data.Bits (testBit)
foreign import ccall "sys/ioctl.h ioctl" ioctlChar ::
CInt -> CInt -> Ptr CChar -> IO CInt
data PowerMate =
PowerMate { readHandle :: Handle, writeHandle :: Handle }
deriving (Eq, Show)
data Status = Status {
brightness :: Int,
pulse_speed :: Int,
pulse_mode :: Int,
pulse_asleep :: Bool,
pulse_awake :: Bool
} deriving (Eq, Ord, Show, Read)
statusInit :: Status
statusInit = Status 0 0 0 False False
ioctlName :: Fd -> IO String
ioctlName (Fd fd) = do
withCAString (take 255 (repeat '\0')) $ \buf -> do
throwErrnoIf (< 0) "ioctl" $ ioctlChar fd 2164212998 buf
peekCString buf
getUSBName :: FilePath -> IO String
getUSBName filename = do
bracket (openFd filename ReadOnly Nothing defaultFileFlags) closeFd ioctlName
searchForDevice :: IO (Maybe FilePath)
searchForDevice = do
files <- getDirectoryContents basedir
let goodfiles = filter ("event" `isPrefixOf`) files
let paths = [basedir ++ "/" ++ file | file <- goodfiles]
inputs <- filterM deviceIsGood paths
return $ case inputs of
[] -> Nothing
(x:_) -> Just x
where basedir = "/dev/input"
deviceIsGood path = do
name <- getUSBName path
return $ nameIsGood name
nameIsGood "Griffin PowerMate" = True
nameIsGood _ = False
openDevice :: FilePath -> IO PowerMate
openDevice file = do
rHandle <- openBinaryFile file ReadMode
hSetBuffering rHandle NoBuffering
wHandle <- openBinaryFile file WriteMode
hSetBuffering wHandle NoBuffering
return $ PowerMate { readHandle = rHandle, writeHandle = wHandle }
data Event = Button Bool
| Rotate Int
| StatusChange Status
deriving (Eq, Ord, Show, Read)
decodeEvent :: (Word16, Word16, Word32) -> Maybe Event
decodeEvent (1, _, value) = Just $ Button (value == 1)
decodeEvent (2, _, value) = Just $ Rotate (fromIntegral value)
decodeEvent (4, _, value) = Just $ StatusChange (decodePulseLED value)
decodeEvent (0, 0, 0) = Nothing
decodeEvent (typ, code, value) = trace ("Unhandled event: " ++ show typ ++ "," ++ show code ++ "," ++ show value) Nothing
eventSize :: Int
eventSize = (24)
readEvent :: PowerMate -> IO Event
readEvent pmate = do
mby <- readEvent' pmate
case mby of
Nothing -> readEvent pmate
(Just ev) -> return ev
readEvent' :: PowerMate -> IO (Maybe Event)
readEvent' handle = do
allocaBytes eventSize $ \buf -> do
let rHandle = readHandle handle
readsize <- hGetBuf rHandle buf eventSize
when (readsize /= eventSize) $ fail $ "unexpected EOF on " ++ (show rHandle)
typ <- (\hsc_ptr -> peekByteOff hsc_ptr 16) buf :: IO Word16
code <- (\hsc_ptr -> peekByteOff hsc_ptr 18) buf :: IO Word16
value <- (\hsc_ptr -> peekByteOff hsc_ptr 20) buf :: IO Word32
return $ decodeEvent (typ, code, value)
writeEvent :: PowerMate -> Word16 -> Word16 -> Word32 -> IO ()
writeEvent handle typ code value = do
allocaBytes eventSize $ \buf -> do
(\hsc_ptr -> pokeByteOff hsc_ptr 16) buf typ
(\hsc_ptr -> pokeByteOff hsc_ptr 18) buf code
(\hsc_ptr -> pokeByteOff hsc_ptr 20) buf value
hPutBuf (writeHandle handle) buf eventSize
encodePulseLED :: Status -> Word32
encodePulseLED status =
enc_brightness .|. enc_speed .|. enc_mode .|. enc_asleep .|. enc_awake where
enc_brightness = fromIntegral (brightness status)
enc_speed = fromIntegral (pulse_speed status) `shiftL` 8
enc_mode = fromIntegral (pulse_mode status) `shiftL` 17
enc_asleep = boolBit (pulse_asleep status) `shiftL` 19
enc_awake = boolBit (pulse_awake status) `shiftL` 20
boolBit True = 1
boolBit False = 0
decodePulseLED :: Word32 -> Status
decodePulseLED word = Status { brightness=b, pulse_speed=ps, pulse_mode=pm,
pulse_asleep=pas, pulse_awake=paw } where
b = fromIntegral $ word .&. 0xFF
ps = fromIntegral $ (word `shiftR` 8) .&. 0x1FF
pm = fromIntegral $ (word `shiftR` 17) .&. 0x3
pas = Data.Bits.testBit word 19
paw = Data.Bits.testBit word 20
writeStatus :: PowerMate -> Status -> IO ()
writeStatus handle status = writeEvent handle typ code value where
typ = 4
code = 1
value = encodePulseLED status
closeDevice :: PowerMate -> IO ()
closeDevice pmate = do
hClose (readHandle pmate)
hClose (writeHandle pmate)