{-# LINE 1 "System/CWiid.hsc" #-}
{-# LANGUAGE ForeignFunctionInterface #-}
module System.CWiid
(
cwiidOpen,
CWiidWiimote,
CWiidState(..),
cwiidSetRptMode,
CWiidLedFlag,
cwiidLed1,
cwiidLed2,
cwiidLed3,
cwiidLed4,
cwiidSetLed,
combineCwiidLedFlag,
cwiidSetRumble,
cwiidGetBtnState, cwiidIsBtnPushed,
cwiidBtn2, cwiidBtn1, cwiidBtnB, cwiidBtnA, cwiidBtnMinus,
cwiidBtnHome, cwiidBtnLeft, cwiidBtnRight, cwiidBtnDown, cwiidBtnUp,
cwiidBtnPlus, combineCwiidBtnFlag, diffCwiidBtnFlag,
CWiidBtnFlag(..),
cwiidGetAcc,
CWiidAcc(..),
CWiidIRSrc(..),
cwiidGetIR
) 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)
{-# LINE 86 "System/CWiid.hsc" #-}
alignment = sizeOf
poke bdat (CWiidBdaddr b0 b1 b2 b3 b4 b5) = do
((\hsc_ptr -> pokeByteOff hsc_ptr 0)) bdat b0
{-# LINE 89 "System/CWiid.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 1)) bdat b1
{-# LINE 90 "System/CWiid.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 2)) bdat b2
{-# LINE 91 "System/CWiid.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 3)) bdat b3
{-# LINE 92 "System/CWiid.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 4)) bdat b4
{-# LINE 93 "System/CWiid.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 5)) bdat b5
{-# LINE 94 "System/CWiid.hsc" #-}
peek bdat = do
b0 <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) bdat
{-# LINE 96 "System/CWiid.hsc" #-}
b1 <- ((\hsc_ptr -> peekByteOff hsc_ptr 1)) bdat
{-# LINE 97 "System/CWiid.hsc" #-}
b2 <- ((\hsc_ptr -> peekByteOff hsc_ptr 2)) bdat
{-# LINE 98 "System/CWiid.hsc" #-}
b3 <- ((\hsc_ptr -> peekByteOff hsc_ptr 3)) bdat
{-# LINE 99 "System/CWiid.hsc" #-}
b4 <- ((\hsc_ptr -> peekByteOff hsc_ptr 4)) bdat
{-# LINE 100 "System/CWiid.hsc" #-}
b5 <- ((\hsc_ptr -> peekByteOff hsc_ptr 5)) bdat
{-# LINE 101 "System/CWiid.hsc" #-}
return $ CWiidBdaddr b0 b1 b2 b3 b4 b5
newtype CWiidWiimote = CWiidWiimote { unCWiidWiimote :: Ptr () }
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
data CWiidState = CWiidState
{ rptMode :: Int, led :: Int, rumble :: Int,
battery :: Int, buttons :: Int, acc :: [Int]
, irSrc :: [CWiidIRSrc]
}
deriving Show
instance Storable CWiidState where
sizeOf = const (64)
{-# LINE 160 "System/CWiid.hsc" #-}
alignment = sizeOf
poke cwst (CWiidState rp l ru ba bu [ac0,ac1,ac2] irs) = do
((\hsc_ptr -> pokeByteOff hsc_ptr 0)) cwst rp
{-# LINE 163 "System/CWiid.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 1)) cwst l
{-# LINE 164 "System/CWiid.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 2)) cwst ru
{-# LINE 165 "System/CWiid.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 3)) cwst ba
{-# LINE 166 "System/CWiid.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 4)) cwst bu
{-# LINE 167 "System/CWiid.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 6)) cwst (fromIntegral ac0 :: CUChar)
{-# LINE 168 "System/CWiid.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 7)) cwst (fromIntegral ac1 :: CUChar)
{-# LINE 169 "System/CWiid.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 8)) cwst (fromIntegral ac2 :: CUChar)
{-# LINE 170 "System/CWiid.hsc" #-}
pokeArray (((\hsc_ptr -> hsc_ptr `plusPtr` 10)) cwst) irs
{-# LINE 171 "System/CWiid.hsc" #-}
peek cwst = do
rp <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) cwst
{-# LINE 173 "System/CWiid.hsc" #-}
l <- ((\hsc_ptr -> peekByteOff hsc_ptr 1)) cwst
{-# LINE 174 "System/CWiid.hsc" #-}
ru <- ((\hsc_ptr -> peekByteOff hsc_ptr 2)) cwst
{-# LINE 175 "System/CWiid.hsc" #-}
ba <- ((\hsc_ptr -> peekByteOff hsc_ptr 3)) cwst
{-# LINE 176 "System/CWiid.hsc" #-}
bu <- ((\hsc_ptr -> peekByteOff hsc_ptr 4)) cwst
{-# LINE 177 "System/CWiid.hsc" #-}
ac0 <- ((\hsc_ptr -> peekByteOff hsc_ptr 6)) cwst
{-# LINE 178 "System/CWiid.hsc" #-}
ac1 <- ((\hsc_ptr -> peekByteOff hsc_ptr 7)) cwst
{-# LINE 179 "System/CWiid.hsc" #-}
ac2 <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) cwst
{-# LINE 180 "System/CWiid.hsc" #-}
irs <- peekArray cwiidIrSrcCount (((\hsc_ptr -> hsc_ptr `plusPtr` 10)) cwst)
{-# LINE 181 "System/CWiid.hsc" #-}
return $ CWiidState rp l ru ba bu [ fromIntegral (ac0 :: CUChar)
, fromIntegral (ac1 :: CUChar)
, fromIntegral (ac2 :: CUChar)]
irs
cwiidIrSrcCount :: Int
cwiidIrSrcCount = (4)
{-# LINE 192 "System/CWiid.hsc" #-}
data CWiidIRSrc = CWiidIRSrc
{ cwiidIRSrcValid :: Bool
, cwiidIRSrcPosX :: Int
, cwiidIRSrcPosY :: Int
, cwiidIRSrcSize :: Int
}
deriving Show
instance Storable CWiidIRSrc where
sizeOf = const (8)
{-# LINE 215 "System/CWiid.hsc" #-}
alignment = sizeOf
poke cwst (CWiidIRSrc valid posX posY sz) = do
((\hsc_ptr -> pokeByteOff hsc_ptr 0)) cwst ((if valid then (-1) else 0) :: CChar)
{-# LINE 218 "System/CWiid.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 2)) cwst (fromIntegral posX :: CUShort)
{-# LINE 219 "System/CWiid.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 4)) cwst (fromIntegral posY :: CUShort)
{-# LINE 220 "System/CWiid.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 6)) cwst (fromIntegral sz :: CChar)
{-# LINE 221 "System/CWiid.hsc" #-}
peek cwst = do
valid <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) cwst
{-# LINE 223 "System/CWiid.hsc" #-}
posX <- ((\hsc_ptr -> peekByteOff hsc_ptr 2)) cwst
{-# LINE 224 "System/CWiid.hsc" #-}
posY <- ((\hsc_ptr -> peekByteOff hsc_ptr 4)) cwst
{-# LINE 225 "System/CWiid.hsc" #-}
sz <- ((\hsc_ptr -> peekByteOff hsc_ptr 6)) cwst
{-# LINE 226 "System/CWiid.hsc" #-}
return $ CWiidIRSrc (not ((valid :: CChar) == 0))
(fromIntegral (posX :: CUShort))
(fromIntegral (posY :: CUShort))
(fromIntegral (sz :: CChar))
cwiidGetIR :: CWiidWiimote -> IO [CWiidIRSrc]
cwiidGetIR wm =
alloca $ \wiState -> do
_ <- c_cwiid_get_state handle wiState
ws <- peek wiState
return (irSrc ws)
where handle = unCWiidWiimote wm
newtype CWiidLedFlag = CWiidLedFlag { unCWiidLedFlag :: Int }
deriving (Eq, Show)
cwiidLed1 :: CWiidLedFlag
cwiidLed1 = CWiidLedFlag 1
{-# LINE 248 "System/CWiid.hsc" #-}
cwiidLed2 :: CWiidLedFlag
cwiidLed2 = CWiidLedFlag 2
{-# LINE 254 "System/CWiid.hsc" #-}
cwiidLed3 :: CWiidLedFlag
cwiidLed3 = CWiidLedFlag 4
{-# LINE 260 "System/CWiid.hsc" #-}
cwiidLed4 :: CWiidLedFlag
cwiidLed4 = CWiidLedFlag 8
{-# LINE 266 "System/CWiid.hsc" #-}
cwiidSetLed :: CWiidWiimote -> CWiidLedFlag -> IO CInt
cwiidSetLed wm leds = c_cwiid_set_led handle ledUChars
where handle = unCWiidWiimote wm
ledUChars = fromIntegral (unCWiidLedFlag leds)
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
{-# LINE 300 "System/CWiid.hsc" #-}
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
newtype CWiidRptMode = CWiidRptMode { unCWiidRptMode :: CUChar }
deriving (Eq, Show)
cwiidSetRptMode :: CWiidWiimote -> CUChar -> IO CInt
cwiidSetRptMode wm u = c_cwiid_set_rpt_mode handle u
where handle = unCWiidWiimote wm
cwiidSetRumble :: CWiidWiimote -> CUChar -> IO CInt
cwiidSetRumble wm rm = c_cwiid_set_rumble handle rm
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
cwiidIsBtnPushed :: CWiidBtnFlag
-> CWiidBtnFlag
-> Bool
cwiidIsBtnPushed flags btn =
unCWiidBtnFlag flags .&. unCWiidBtnFlag btn == unCWiidBtnFlag btn
newtype CWiidAcc = CWiidAcc { unCWiidAcc :: [Int] }
deriving (Eq, Show)
cwiidGetAcc :: CWiidWiimote -> IO CWiidAcc
cwiidGetAcc wm =
alloca $ \wiState -> do
_ <- c_cwiid_get_state handle wiState
ws <- peek wiState
return $ CWiidAcc $ acc 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_set_rumble" c_cwiid_set_rumble
:: Ptr () -> CUChar -> IO CInt
foreign import ccall safe "cwiid_get_state" c_cwiid_get_state
:: Ptr () -> Ptr CWiidState -> IO CInt