diff --git a/System/Linux/Input/Device.hsc b/System/Linux/Input/Device.hsc new file mode 100644 --- /dev/null +++ b/System/Linux/Input/Device.hsc @@ -0,0 +1,90 @@ +{-# LANGUAGE ForeignFunctionInterface #-} + +module System.Linux.Input.Device ( + getDeviceName + , getDeviceId + , InputId (..) + ) where + +import Prelude hiding (product) +import qualified Data.ByteString.Char8 as BSC +import qualified Data.ByteString.Unsafe as BSC +import Foreign +import Foreign.C +import System.IO (Handle) +import System.Posix.Types +import System.Posix.IO (handleToFd) + +#include + +foreign import ccall "ioctl" c_ioctl :: CInt -> CInt -> Ptr () -> IO CInt + +c_ioctl' :: Fd -> CInt -> Ptr d -> IO () +c_ioctl' f req p = + throwErrnoIfMinus1_ "ioctl" $ + c_ioctl (fromIntegral f) req (castPtr p) + +getDeviceName :: Handle -> IO BSC.ByteString +getDeviceName h = withFd h $ \f->do + BSC.takeWhile (/='\0') `fmap` ioctlBS f #{const EVIOCGNAME(0)} (BSC.replicate 255 '\0') + +ioctlBS :: Fd -> Int -> BSC.ByteString -> IO BSC.ByteString +ioctlBS f req buf = do + BSC.unsafeUseAsCString buf $ \p -> do + print $ (sizedIoctl req $ BSC.length buf, #{const EVIOCGNAME(255)}) + c_ioctl' f (sizedIoctl req $ BSC.length buf) p + return buf + +-- | Sets the size of an ioctl request number +sizedIoctl :: Int -> Int -> CInt +sizedIoctl req size = + fromIntegral $ (req .&. complement (mask `shiftL` shift)) + .|. ((mask .&. size) `shiftL` shift) + where + mask = #{const _IOC_SIZEMASK} + shift = #{const _IOC_SIZESHIFT} + +data InputId = InputId { busType :: Word16 + , vendor :: Word16 + , product :: Word16 + , version :: Word16 + } + deriving (Ord, Eq, Show) + +instance Storable InputId where + sizeOf _ = 8 + alignment _ = 8 + peek p = do + busType <- peekElemOff p' 0 + vendor <- peekElemOff p' 1 + product <- peekElemOff p' 2 + version <- peekElemOff p' 3 + return $ InputId busType vendor product version + where p' = castPtr p :: Ptr Word16 + + poke p i = do + pokeElemOff p' 0 $ busType i + pokeElemOff p' 1 $ vendor i + pokeElemOff p' 2 $ product i + pokeElemOff p' 3 $ version i + where p' = castPtr p :: Ptr Word16 + +-- | Invoke ioctl with a Storable argument +ioctlStorable :: Storable a => Fd -> Int -> a -> IO a +ioctlStorable f req a = alloca $ \p -> do + poke p a + c_ioctl' f (fromIntegral req) p + peek p + +-- | Invoke ioctl with an uninitialized Storable argument +ioctlStorable' :: Storable a => Fd -> Int -> IO a +ioctlStorable' f req = alloca $ \p -> do + c_ioctl' f (fromIntegral req) p + peek p + +withFd :: Handle -> (Fd -> IO a) -> IO a +withFd h action = handleToFd h >>= action + +getDeviceId :: Handle -> IO InputId +getDeviceId h = + withFd h $ \f->ioctlStorable' f #{const EVIOCGID} diff --git a/System/Linux/Input/Event.hsc b/System/Linux/Input/Event.hsc --- a/System/Linux/Input/Event.hsc +++ b/System/Linux/Input/Event.hsc @@ -3,6 +3,7 @@ module System.Linux.Input.Event ( -- * Events Event(..) , hReadEvent + , KeyEventType(..) , module System.Linux.Input.Event.Constants ) where @@ -26,23 +27,27 @@ -- | An Event data Event = SyncEvent { evTimestamp :: DiffTime , evSyncCode :: SyncType } - | KeyEvent { evTimestamp :: DiffTime - , evKeyCode :: Key } - | RelEvent { evTimestamp :: DiffTime - , evRelAxis :: RelAxis - , evValue :: Int32 } - | AbsEvent { evTimestamp :: DiffTime - , evAbsAxis :: AbsAxis - , evValue :: Int32 } - | MscEvent { evTimestamp :: DiffTime } - | SwEvent { evTimestamp :: DiffTime } - | LedEvent { evTimestamp :: DiffTime } - | SndEvent { evTimestamp :: DiffTime } - | RepEvent { evTimestamp :: DiffTime } - | FfEvent { evTimestamp :: DiffTime } + | KeyEvent { evTimestamp :: DiffTime + , evKeyCode :: Key + , evKeyEventType :: KeyEventType } + | RelEvent { evTimestamp :: DiffTime + , evRelAxis :: RelAxis + , evValue :: Int32 } + | AbsEvent { evTimestamp :: DiffTime + , evAbsAxis :: AbsAxis + , evValue :: Int32 } + | MscEvent { evTimestamp :: DiffTime } + | SwEvent { evTimestamp :: DiffTime } + | LedEvent { evTimestamp :: DiffTime } + | SndEvent { evTimestamp :: DiffTime } + | RepEvent { evTimestamp :: DiffTime } + | FfEvent { evTimestamp :: DiffTime } | FfStatusEvent { evTimestamp :: DiffTime } - deriving (Show, Eq) + deriving (Show, Eq) +data KeyEventType = Released | Depressed | Repeated + deriving (Show, Eq, Ord, Enum, Bounded) + instance Storable Event where sizeOf _ = (#size struct input_event) alignment = sizeOf @@ -55,15 +60,20 @@ let t = 1000000000000*fromIntegral (sec::Int) + 1000000*fromIntegral (usec::Int) return $ case _type of (#const EV_SYN) -> SyncEvent { evTimestamp = picosecondsToDiffTime t - , evSyncCode = SyncType code } + , evSyncCode = SyncType code + } (#const EV_KEY) -> KeyEvent { evTimestamp = picosecondsToDiffTime t - , evKeyCode = Key code } + , evKeyCode = Key code + , evKeyEventType = toEnum (fromIntegral value) + } (#const EV_REL) -> RelEvent { evTimestamp = picosecondsToDiffTime t , evRelAxis = RelAxis code - , evValue = value } + , evValue = value + } (#const EV_ABS) -> AbsEvent { evTimestamp = picosecondsToDiffTime t , evAbsAxis = AbsAxis code - , evValue = value } + , evValue = value + } (#const EV_MSC) -> MscEvent { evTimestamp = picosecondsToDiffTime t } (#const EV_SW ) -> SwEvent { evTimestamp = picosecondsToDiffTime t } (#const EV_LED) -> LedEvent { evTimestamp = picosecondsToDiffTime t } @@ -73,7 +83,7 @@ (#const EV_FF_STATUS) -> FfStatusEvent { evTimestamp = picosecondsToDiffTime t } otherwise -> error $ "unknown event type: " ++ show _type - poke = undefined + poke = error "Storable(System.Linux.Input.Event): poke not supported" -- | Read an event hReadEvent :: Handle -> IO (Maybe Event) diff --git a/System/Linux/Input/Event/Constants.hsc b/System/Linux/Input/Event/Constants.hsc --- a/System/Linux/Input/Event/Constants.hsc +++ b/System/Linux/Input/Event/Constants.hsc @@ -21,6 +21,17 @@ #{enum Key, Key , key_reserved = KEY_RESERVED , key_esc = KEY_ESC + + , btn_0 = BTN_0 + , btn_1 = BTN_1 + , btn_2 = BTN_2 + , btn_3 = BTN_3 + , btn_4 = BTN_4 + , btn_5 = BTN_5 + , btn_6 = BTN_6 + , btn_7 = BTN_7 + , btn_8 = BTN_8 + , btn_9 = BTN_9 } newtype RelAxis = RelAxis Word16 deriving (Show, Eq) diff --git a/linux-evdev.cabal b/linux-evdev.cabal --- a/linux-evdev.cabal +++ b/linux-evdev.cabal @@ -1,5 +1,5 @@ Name: linux-evdev -Version: 0.2 +Version: 0.3 Synopsis: Bindings to Linux evdev input device interface. Description: Bindings to Linux evdev input device interface. License: BSD3 @@ -11,11 +11,14 @@ Cabal-version: >=1.6 Library - Exposed-modules: System.Linux.Input.Event, System.Linux.Input.Event.Constants + Exposed-modules: System.Linux.Input.Event, + System.Linux.Input.Event.Constants, + System.Linux.Input.Device Build-tools: hsc2hs Build-depends: base >= 4.0 && < 5.0, time >= 1.4 && < 1.5, - bytestring >= 0.9 && < 0.11 + bytestring >= 0.9 && < 0.11, + unix >= 2.6 && < 2.8 source-repository head type: git