module System.CWiid
(cwiidOpen, cwiidSetLed, cwiidSetRptMode, cwiidGetBtnState,
cwiidLed1, cwiidLed2, cwiidLed3, cwiidLed4, combineCwiidLedFlag,
cwiidBtn2, cwiidBtn1, cwiidBtnB, cwiidBtnA, cwiidBtnMinus,
cwiidBtnHome, cwiidBtnLeft, cwiidBtnRight, cwiidBtnDown, cwiidBtnUp,
cwiidBtnPlus, combineCwiidBtnFlag, diffCwiidBtnFlag,
CWiidBtnFlag(..), CWiidState(..), CWiidWiimote) where
import Data.Bits
import Foreign.C.Types
import Foreign.Marshal
import Foreign.Ptr
import Foreign.Storable
data CWiidBdaddr = CWiidBdaddr Int Int Int Int Int Int
instance Storable CWiidBdaddr where
sizeOf = const (6)
alignment = sizeOf
poke bdat (CWiidBdaddr b0 b1 b2 b3 b4 b5) = do
((\hsc_ptr -> pokeByteOff hsc_ptr 0)) bdat b0
((\hsc_ptr -> pokeByteOff hsc_ptr 1)) bdat b1
((\hsc_ptr -> pokeByteOff hsc_ptr 2)) bdat b2
((\hsc_ptr -> pokeByteOff hsc_ptr 3)) bdat b3
((\hsc_ptr -> pokeByteOff hsc_ptr 4)) bdat b4
((\hsc_ptr -> pokeByteOff hsc_ptr 5)) bdat b5
peek bdat = do
b0 <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) bdat
b1 <- ((\hsc_ptr -> peekByteOff hsc_ptr 1)) bdat
b2 <- ((\hsc_ptr -> peekByteOff hsc_ptr 2)) bdat
b3 <- ((\hsc_ptr -> peekByteOff hsc_ptr 3)) bdat
b4 <- ((\hsc_ptr -> peekByteOff hsc_ptr 4)) bdat
b5 <- ((\hsc_ptr -> peekByteOff hsc_ptr 5)) bdat
return $ CWiidBdaddr b0 b1 b2 b3 b4 b5
newtype CWiidWiimote = CWiidWiimote { unCWiidWiimote :: Ptr () }
newtype CWiidLedFlag = CWiidLedFlag { unCWiidLedFlag :: Int }
deriving (Eq, Show)
cwiidLed1 :: CWiidLedFlag
cwiidLed1 = CWiidLedFlag 1
cwiidLed2 :: CWiidLedFlag
cwiidLed2 = CWiidLedFlag 2
cwiidLed3 :: CWiidLedFlag
cwiidLed3 = CWiidLedFlag 4
cwiidLed4 :: CWiidLedFlag
cwiidLed4 = CWiidLedFlag 8
combineCwiidLedFlag :: [CWiidLedFlag] -> CWiidLedFlag
combineCwiidLedFlag = CWiidLedFlag . foldr ((.|.) . unCWiidLedFlag) 0
newtype CWiidBtnFlag = CWiidBtnFlag { unCWiidBtnFlag :: Int }
deriving (Eq, Show)
cwiidBtn2 :: CWiidBtnFlag
cwiidBtn2 = CWiidBtnFlag 1
cwiidBtn1 :: CWiidBtnFlag
cwiidBtn1 = CWiidBtnFlag 2
cwiidBtnB :: CWiidBtnFlag
cwiidBtnB = CWiidBtnFlag 4
cwiidBtnA :: CWiidBtnFlag
cwiidBtnA = CWiidBtnFlag 8
cwiidBtnMinus :: CWiidBtnFlag
cwiidBtnMinus = CWiidBtnFlag 16
cwiidBtnHome :: CWiidBtnFlag
cwiidBtnHome = CWiidBtnFlag 128
cwiidBtnLeft :: CWiidBtnFlag
cwiidBtnLeft = CWiidBtnFlag 256
cwiidBtnRight :: CWiidBtnFlag
cwiidBtnRight = CWiidBtnFlag 512
cwiidBtnDown :: CWiidBtnFlag
cwiidBtnDown = CWiidBtnFlag 1024
cwiidBtnUp :: CWiidBtnFlag
cwiidBtnUp = CWiidBtnFlag 2048
cwiidBtnPlus :: CWiidBtnFlag
cwiidBtnPlus = CWiidBtnFlag 4096
combineCwiidBtnFlag :: [CWiidBtnFlag] -> CWiidBtnFlag
combineCwiidBtnFlag = CWiidBtnFlag . foldr ((.|.) . unCWiidBtnFlag) 0
diffCwiidBtnFlag :: CWiidBtnFlag -> CWiidBtnFlag -> CWiidBtnFlag
diffCwiidBtnFlag a b = CWiidBtnFlag $ ai (ai .&. bi)
where ai = unCWiidBtnFlag a
bi = unCWiidBtnFlag b
data CWiidState = CWiidState { rptMode :: Int, led :: Int, rumble :: Int,
battery :: Int, buttons :: Int }
deriving Show
instance Storable CWiidState where
sizeOf = const (60)
alignment = sizeOf
poke cwst (CWiidState rp l ru ba bu) = do
((\hsc_ptr -> pokeByteOff hsc_ptr 0)) cwst rp
((\hsc_ptr -> pokeByteOff hsc_ptr 1)) cwst l
((\hsc_ptr -> pokeByteOff hsc_ptr 2)) cwst ru
((\hsc_ptr -> pokeByteOff hsc_ptr 3)) cwst ba
((\hsc_ptr -> pokeByteOff hsc_ptr 4)) cwst bu
peek cwst = do
rp <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) cwst
l <- ((\hsc_ptr -> peekByteOff hsc_ptr 1)) cwst
ru <- ((\hsc_ptr -> peekByteOff hsc_ptr 2)) cwst
ba <- ((\hsc_ptr -> peekByteOff hsc_ptr 3)) cwst
bu <- ((\hsc_ptr -> peekByteOff hsc_ptr 4)) cwst
return $ CWiidState rp l ru ba bu
cwiidOpen :: IO (Maybe CWiidWiimote)
cwiidOpen =
alloca $ \bdAddr -> do
poke bdAddr $ CWiidBdaddr 0 0 0 0 0 0
handle <- c_cwiid_open bdAddr 0
if handle == nullPtr
then return Nothing
else return $ Just $ CWiidWiimote handle
cwiidSetLed :: CWiidWiimote -> IO CInt
cwiidSetLed wm = c_cwiid_set_led handle 9
where handle = unCWiidWiimote wm
cwiidSetRptMode :: CWiidWiimote -> IO CInt
cwiidSetRptMode wm = c_cwiid_set_rpt_mode handle 2
where handle = unCWiidWiimote wm
cwiidGetBtnState :: CWiidWiimote -> IO CWiidBtnFlag
cwiidGetBtnState wm =
alloca $ \wiState -> do
_ <- c_cwiid_get_state handle wiState
ws <- peek wiState
return $ CWiidBtnFlag $ buttons ws
where handle = unCWiidWiimote wm
foreign import ccall safe "cwiid_open" c_cwiid_open
:: Ptr CWiidBdaddr -> CInt -> IO (Ptr ())
foreign import ccall safe "cwiid_set_led" c_cwiid_set_led
:: Ptr () -> CUChar -> IO CInt
foreign import ccall safe "cwiid_set_rpt_mode" c_cwiid_set_rpt_mode
:: Ptr () -> CUChar -> IO CInt
foreign import ccall safe "cwiid_get_state" c_cwiid_get_state
:: Ptr () -> Ptr CWiidState -> IO CInt