290 lines
8.8 KiB
Haskell
290 lines
8.8 KiB
Haskell
{-# LANGUAGE ForeignFunctionInterface, DeriveDataTypeable, GeneralizedNewtypeDeriving #-}
|
|
|
|
module HWiid ( BDAddr(..)
|
|
, Wiimote
|
|
, WiimoteIRSource(..)
|
|
, WiimoteState(..)
|
|
, WiimoteMesg(..)
|
|
, nullWiimote
|
|
, bdAddrAny
|
|
, hwiidFlagMesgInterface
|
|
, hwiidFlagNonblock
|
|
, hwiidReportStatus
|
|
, hwiidReportButtons
|
|
, hwiidReportIR
|
|
, hwiidLed1
|
|
, hwiidLed2
|
|
, hwiidLed3
|
|
, hwiidLed4
|
|
, hwiidButton2
|
|
, hwiidButton1
|
|
, hwiidButtonB
|
|
, hwiidButtonA
|
|
, hwiidButtonMinus
|
|
, hwiidButtonHome
|
|
, hwiidButtonLeft
|
|
, hwiidButtonRight
|
|
, hwiidButtonDown
|
|
, hwiidButtonUp
|
|
, hwiidButtonPlus
|
|
, hwiidNunchukButtonZ
|
|
, hwiidNunchukButtonC
|
|
, hwiidMesgTypeStatus
|
|
, hwiidMesgTypeButton
|
|
, hwiidOpen
|
|
, hwiidOpenTimeout
|
|
, hwiidClose
|
|
, hwiidGetState
|
|
, hwiidSetReportMode
|
|
, hwiidSetLed
|
|
, hwiidGetMesg
|
|
) where
|
|
|
|
|
|
import Data.Bits
|
|
import Data.Int
|
|
import Data.Typeable
|
|
import Data.Word
|
|
import Foreign.C.Types
|
|
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)
|
|
|
|
hwiidFlagNonblock :: CInt
|
|
hwiidFlagNonblock = (#const CWIID_FLAG_NONBLOCK)
|
|
|
|
|
|
hwiidReportStatus :: Word8
|
|
hwiidReportStatus = (#const CWIID_RPT_STATUS)
|
|
|
|
hwiidReportButtons :: Word8
|
|
hwiidReportButtons = (#const CWIID_RPT_BTN)
|
|
|
|
hwiidReportIR :: Word8
|
|
hwiidReportIR = (#const CWIID_RPT_IR)
|
|
|
|
|
|
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)
|
|
|
|
|
|
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)
|
|
|
|
|
|
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 WiimoteIRSource = WiimoteIRSource
|
|
{ irValid :: CChar
|
|
, irPosX :: Word16
|
|
, irPosY :: Word16
|
|
, irSize :: Int8
|
|
} deriving (Eq, Show)
|
|
|
|
instance Storable WiimoteIRSource where
|
|
sizeOf _ = (#size struct cwiid_ir_src)
|
|
alignment _ = alignment (undefined :: CInt)
|
|
|
|
peek src = do
|
|
valid <- (#peek struct cwiid_ir_src, valid) src
|
|
posx <- (#peek struct cwiid_ir_src, pos[0]) src
|
|
posy <- (#peek struct cwiid_ir_src, pos[1]) src
|
|
size <- (#peek struct cwiid_ir_src, size) src
|
|
return $ WiimoteIRSource valid posx posy size
|
|
|
|
poke _ _ = error "Can't write WiimoteIRSource"
|
|
|
|
data WiimoteState = WiimoteState
|
|
{ stateLed :: Word8
|
|
, stateRumble :: Word8
|
|
, stateBattery :: Word8
|
|
, stateButtons :: Word16
|
|
, stateIRSources :: [WiimoteIRSource]
|
|
} deriving (Eq, Show)
|
|
|
|
instance Storable WiimoteState where
|
|
sizeOf _ = (#size struct cwiid_state)
|
|
alignment _ = alignment (undefined :: CInt)
|
|
|
|
peek state = do
|
|
led <- (#peek struct cwiid_state, led) state
|
|
rumble <- (#peek struct cwiid_state, rumble) state
|
|
battery <- (#peek struct cwiid_state, battery) state
|
|
buttons <- (#peek struct cwiid_state, buttons) state
|
|
irSources <- peekArray (#const CWIID_IR_SRC_COUNT) $ (#ptr struct cwiid_state, ir_src) state
|
|
return $ WiimoteState led rumble battery buttons (filter (\src -> (irValid src) /= 0) irSources)
|
|
|
|
poke _ _ = fail "Can't write WiimoteState"
|
|
|
|
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
|
|
{ mesgType :: (#type enum cwiid_mesg_type)
|
|
}
|
|
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 mesgtype
|
|
|
|
|
|
poke _ _ = fail "Can't write WiimoteMesg"
|
|
|
|
|
|
newtype Wiimote = Wiimote (Ptr Wiimote) deriving (Eq, Ord, Show, Storable)
|
|
|
|
|
|
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
|
|
|
|
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
|
|
ret <- cwiid_get_mesg wiimote countptr arrayptr timestamp
|
|
count <- peek countptr
|
|
array <- peek arrayptr
|
|
|
|
if (ret == 0) then do
|
|
list <- peekArray (fromIntegral count) array
|
|
free array
|
|
return list
|
|
else return []
|