Added connect & status request

This commit is contained in:
Matthias Schiffer 2010-04-06 23:01:42 +02:00
parent 3ee64bbc17
commit 050f1283eb
3 changed files with 203 additions and 679 deletions

View file

@ -1,9 +1,183 @@
{-# LANGUAGE ForeignFunctionInterface, DeriveDataTypeable #-}
{-# LANGUAGE ForeignFunctionInterface, DeriveDataTypeable, GeneralizedNewtypeDeriving #-}
module HWiid (
module HWiid ( BDAddr(..)
, Wiimote
, WiimoteState(..)
, nullWiimote
, bdAddrAny
, hwiidLed1
, hwiidLed2
, hwiidLed3
, hwiidLed4
, hwiidReportStatus
, hwiidReportButtons
, hwiidOpen
, hwiidOpenTimeout
, hwiidClose
, hwiidGetState
, hwiidSetReportMode
, hwiidSetLed
, hwiidButton2
, hwiidButton1
, hwiidButtonB
, hwiidButtonA
, hwiidButtonMinus
, hwiidButtonHome
, hwiidButtonLeft
, hwiidButtonRight
, hwiidButtonDown
, hwiidButtonUp
, hwiidButtonPlus
, hwiidNunchukButtonZ
, hwiidNunchukButtonC
) where
import Data.Word
import Foreign.C.Types
import Foreign.Marshal.Alloc (alloca)
import Foreign.Marshal.Utils (with)
import Foreign.Ptr
import Foreign.Storable
#include <cwiid.h>
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
newtype Wiimote = Wiimote (Ptr Wiimote) deriving (Eq, Ord, Show, Storable)
hwiidLed1 :: Word8
hwiidLed1 = (#const CWIID_LED1_ON)
hwiidLed2 :: Word8
hwiidLed2 = (#const CWIID_LED2_ON)
hwiidLed3 :: Word8
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)
hwiidButton1 :: Word16
hwiidButton1 = (#const CWIID_BTN_1)
hwiidButtonB :: Word16
hwiidButtonB = (#const CWIID_BTN_B)
hwiidButtonA :: Word16
hwiidButtonA = (#const CWIID_BTN_A)
hwiidButtonMinus :: Word16
hwiidButtonMinus = (#const CWIID_BTN_MINUS)
hwiidButtonHome :: Word16
hwiidButtonHome = (#const CWIID_BTN_HOME)
hwiidButtonLeft :: Word16
hwiidButtonLeft = (#const CWIID_BTN_LEFT)
hwiidButtonRight :: Word16
hwiidButtonRight = (#const CWIID_BTN_RIGHT)
hwiidButtonDown :: Word16
hwiidButtonDown = (#const CWIID_BTN_DOWN)
hwiidButtonUp :: Word16
hwiidButtonUp = (#const CWIID_BTN_UP)
hwiidButtonPlus :: Word16
hwiidButtonPlus = (#const CWIID_BTN_PLUS)
hwiidNunchukButtonZ :: Word16
hwiidNunchukButtonZ = (#const CWIID_NUNCHUK_BTN_Z)
hwiidNunchukButtonC :: Word16
hwiidNunchukButtonC = (#const CWIID_NUNCHUK_BTN_C)
nullWiimote :: Wiimote
nullWiimote = Wiimote nullPtr
foreign import ccall unsafe "cwiid.h cwiid_open_timeout"
cwiid_open_timeout :: Ptr BDAddr -> CInt -> CInt -> IO Wiimote
hwiidOpenTimeout :: BDAddr -> CInt -> CInt -> IO Wiimote
hwiidOpenTimeout addr flags timeout = with addr $ \addrptr -> cwiid_open_timeout addrptr flags timeout
defaultTimeout :: CInt
defaultTimeout = 5
hwiidOpen :: BDAddr -> CInt -> IO Wiimote
hwiidOpen addr flags = hwiidOpenTimeout addr flags defaultTimeout
foreign import ccall unsafe "cwiid.h cwiid_close"
hwiidClose :: Wiimote -> IO CInt
foreign import ccall unsafe "cwiid.h cwiid_get_state"
cwiid_get_state :: Wiimote -> Ptr WiimoteState -> IO CInt
hwiidGetState :: Wiimote -> IO WiimoteState
hwiidGetState wiimote = alloca $ \state -> do
cwiid_get_state wiimote state
peek state
foreign import ccall unsafe "cwiid.h cwiid_set_rpt_mode"
hwiidSetReportMode :: Wiimote -> Word8 -> IO CInt
foreign import ccall unsafe "cwiid.h cwiid_set_led"
hwiidSetLed :: Wiimote -> Word8 -> IO CInt