Added connect & status request
This commit is contained in:
parent
3ee64bbc17
commit
050f1283eb
3 changed files with 203 additions and 679 deletions
178
src/HWiid.hsc
178
src/HWiid.hsc
|
@ -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
|
||||
|
|
Reference in a new issue