diff options
| -rw-r--r-- | hwiid.cabal | 2 | ||||
| -rw-r--r-- | src/HWiid.hsc | 183 |
2 files changed, 128 insertions, 57 deletions
diff --git a/hwiid.cabal b/hwiid.cabal index a3a7837..ce153a8 100644 --- a/hwiid.cabal +++ b/hwiid.cabal @@ -11,7 +11,7 @@ build-type: Simple Cabal-Version: >=1.2 library - build-depends: base >= 4 + build-depends: base >= 4, clock exposed-modules: HWiid hs-source-dirs: src extra-libraries: cwiid diff --git a/src/HWiid.hsc b/src/HWiid.hsc index 3699a05..994aca1 100644 --- a/src/HWiid.hsc +++ b/src/HWiid.hsc @@ -3,20 +3,17 @@ module HWiid ( BDAddr(..) , Wiimote , WiimoteState(..) + , WiimoteMesg(..) , nullWiimote , bdAddrAny + , hwiidFlagMesgInterface + , hwiidFlagNonblock + , hwiidReportStatus + , hwiidReportButtons , hwiidLed1 , hwiidLed2 , hwiidLed3 , hwiidLed4 - , hwiidReportStatus - , hwiidReportButtons - , hwiidOpen - , hwiidOpenTimeout - , hwiidClose - , hwiidGetState - , hwiidSetReportMode - , hwiidSetLed , hwiidButton2 , hwiidButton1 , hwiidButtonB @@ -30,65 +27,43 @@ module HWiid ( BDAddr(..) , hwiidButtonPlus , hwiidNunchukButtonZ , hwiidNunchukButtonC + , hwiidOpen + , hwiidOpenTimeout + , hwiidClose + , hwiidGetState + , hwiidSetReportMode + , hwiidSetLed + , hwiidGetMesg ) where +import Data.Bits +import Data.Typeable import Data.Word import Foreign.C.Types -import Foreign.Marshal.Alloc (alloca) +import Foreign.Marshal.Alloc (alloca, free) +import Foreign.Marshal.Array (peekArray) import Foreign.Marshal.Utils (with) import Foreign.Ptr import Foreign.Storable +import System.Posix.Clock (TimeSpec) #include <cwiid.h> +hwiidFlagMesgInterface :: CInt +hwiidFlagMesgInterface = (#const CWIID_FLAG_MESG_IFC) -data BDAddr = BDAddr (Word8, Word8, Word8, Word8, Word8, Word8) - deriving (Eq, Ord, Show) - -instance Storable BDAddr where - sizeOf _ = (#size bdaddr_t) - alignment _ = alignment (undefined :: CInt) - - peek addr = do - b0 <- peekByteOff addr 0 - b1 <- peekByteOff addr 1 - b2 <- peekByteOff addr 2 - b3 <- peekByteOff addr 3 - b4 <- peekByteOff addr 4 - b5 <- peekByteOff addr 5 - return $ BDAddr (b0, b1, b2, b3, b4, b5) - - poke addr (BDAddr (b0, b1, b2, b3, b4, b5)) = do - pokeByteOff addr 0 b0 - pokeByteOff addr 1 b1 - pokeByteOff addr 2 b2 - pokeByteOff addr 3 b3 - pokeByteOff addr 4 b4 - pokeByteOff addr 5 b5 - -bdAddrAny :: BDAddr -bdAddrAny = BDAddr (0, 0, 0, 0, 0, 0) - +hwiidFlagNonblock :: CInt +hwiidFlagNonblock = (#const CWIID_FLAG_NONBLOCK) -data WiimoteState = WiimoteState - { stateButtons :: Word16 - } deriving (Eq, Show) -instance Storable WiimoteState where - sizeOf _ = (#size struct cwiid_state) - alignment _ = alignment (undefined :: CInt) - - peek state = do - buttons <- (#peek struct cwiid_state, buttons) state - return $ WiimoteState (buttons) - - poke state (WiimoteState (buttons)) = do - (#poke struct cwiid_state, buttons) state buttons +hwiidReportStatus :: Word8 +hwiidReportStatus = (#const CWIID_RPT_STATUS) +hwiidReportButtons :: Word8 +hwiidReportButtons = (#const CWIID_RPT_BTN) -newtype Wiimote = Wiimote (Ptr Wiimote) deriving (Eq, Ord, Show, Storable) hwiidLed1 :: Word8 hwiidLed1 = (#const CWIID_LED1_ON) @@ -102,12 +77,6 @@ hwiidLed3 = (#const CWIID_LED3_ON) hwiidLed4 :: Word8 hwiidLed4 = (#const CWIID_LED4_ON) -hwiidReportStatus :: Word8 -hwiidReportStatus = (#const CWIID_RPT_STATUS) - -hwiidReportButtons :: Word8 -hwiidReportButtons = (#const CWIID_RPT_BTN) - hwiidButton2 :: Word16 hwiidButton2 = (#const CWIID_BTN_2) @@ -150,6 +119,94 @@ hwiidNunchukButtonC :: Word16 hwiidNunchukButtonC = (#const CWIID_NUNCHUK_BTN_C) +hwiidMesgTypeStatus :: (#type enum cwiid_mesg_type) +hwiidMesgTypeStatus = (#const CWIID_MESG_STATUS) + +hwiidMesgTypeButton :: (#type enum cwiid_mesg_type) +hwiidMesgTypeButton = (#const CWIID_MESG_BTN) + + + +data BDAddr = BDAddr (Word8, Word8, Word8, Word8, Word8, Word8) + deriving (Eq, Ord, Show) + +instance Storable BDAddr where + sizeOf _ = (#size bdaddr_t) + alignment _ = alignment (undefined :: CInt) + + peek addr = do + b0 <- peekByteOff addr 0 + b1 <- peekByteOff addr 1 + b2 <- peekByteOff addr 2 + b3 <- peekByteOff addr 3 + b4 <- peekByteOff addr 4 + b5 <- peekByteOff addr 5 + return $ BDAddr (b0, b1, b2, b3, b4, b5) + + poke addr (BDAddr (b0, b1, b2, b3, b4, b5)) = do + pokeByteOff addr 0 b0 + pokeByteOff addr 1 b1 + pokeByteOff addr 2 b2 + pokeByteOff addr 3 b3 + pokeByteOff addr 4 b4 + pokeByteOff addr 5 b5 + +bdAddrAny :: BDAddr +bdAddrAny = BDAddr (0, 0, 0, 0, 0, 0) + + +data WiimoteState = WiimoteState + { stateButtons :: Word16 + } deriving (Eq, Show) + +instance Storable WiimoteState where + sizeOf _ = (#size struct cwiid_state) + alignment _ = alignment (undefined :: CInt) + + peek state = do + buttons <- (#peek struct cwiid_state, buttons) state + return $ WiimoteState (buttons) + + poke state (WiimoteState (buttons)) = do + (#poke struct cwiid_state, buttons) state buttons + + +data WiimoteMesg = WiimoteStatusMesg + { mesgType :: (#type enum cwiid_mesg_type) + , mesgBattery :: Word8 + , mesgExtensionType :: (#type enum cwiid_ext_type) + } + | WiimoteButtonMesg + { mesgType :: (#type enum cwiid_mesg_type) + , mesgButtons :: Word16 + } + | WiimoteMesgUnknown + deriving (Eq, Show) + +instance Storable WiimoteMesg where + sizeOf _ = (#size union cwiid_mesg) + alignment _ = alignment (undefined :: CInt) + + peek mesg = do + mesgtype <- (#peek union cwiid_mesg, type) mesg + + case () of + _ | mesgtype == hwiidMesgTypeStatus -> do + battery <- (#peek struct cwiid_status_mesg, battery) mesg + exttype <- (#peek struct cwiid_status_mesg, ext_type) mesg + return $ WiimoteStatusMesg mesgtype battery exttype + | mesgtype == hwiidMesgTypeButton -> do + buttons <- (#peek struct cwiid_btn_mesg, buttons) mesg + return $ WiimoteButtonMesg mesgtype buttons + | otherwise -> return WiimoteMesgUnknown + + + poke _ _ = error "Can't write WiimoteMesg" + + +newtype Wiimote = Wiimote (Ptr Wiimote) deriving (Eq, Ord, Show, Storable) + + nullWiimote :: Wiimote nullWiimote = Wiimote nullPtr @@ -181,3 +238,17 @@ foreign import ccall unsafe "cwiid.h cwiid_set_rpt_mode" foreign import ccall unsafe "cwiid.h cwiid_set_led" hwiidSetLed :: Wiimote -> Word8 -> IO CInt + +foreign import ccall unsafe "cwiid.h cwiid_get_mesg" + cwiid_get_mesg :: Wiimote -> Ptr CInt -> Ptr (Ptr WiimoteMesg) -> Ptr TimeSpec -> IO CInt + +hwiidGetMesg :: Wiimote -> IO [WiimoteMesg] +hwiidGetMesg wiimote = alloca $ \countptr -> alloca $ \arrayptr -> alloca $ \timestamp -> do + cwiid_get_mesg wiimote countptr arrayptr timestamp + count <- peek countptr + array <- peek arrayptr + + ret <- peekArray (fromIntegral count) array + free array + + return ret
\ No newline at end of file |