diff --git a/CHANGELOG b/CHANGELOG --- a/CHANGELOG +++ b/CHANGELOG @@ -1,3 +1,15 @@ +2014-05-17 Ivan Perez + + * API: adds accelerometer sensing. + * API: uses newtype for leds instead of the low-level CUChar + * Tests: adapts tests to use new rpt_mode and + set_led interface. + * Documentation: adds (some) haddock documentation. + +2014-05-05 Ivan Perez + + * API: removes hard-coded params to SetLed and SetRptMode + 2014-05-01 Ivan Perez * hcwiid.cabal: Version bump (0.0.3) diff --git a/README b/README --- a/README +++ b/README @@ -18,6 +18,7 @@ TODO ======== +* Enable IR. Create an example that uses it. * Locate projects using this. (I am personally working on some games that will be published.) * Write a decent example that uses more than just testing a button thing. diff --git a/System/CWiid.hsc b/System/CWiid.hsc --- a/System/CWiid.hsc +++ b/System/CWiid.hsc @@ -1,13 +1,64 @@ {-# LANGUAGE ForeignFunctionInterface #-} +-- | +-- Module : System.CWiid +-- Copyright : Kiwamu Okabe, Ivan Perez and the cwiid team +-- License : GPL-2 +-- +-- Maintainer : ivan.perez@keera.co.uk +-- Stability : experimental +-- Portability : unknown +-- +-- Bindings for the cwiid library, a working userspace driver +-- along with various applications implementing event drivers, +-- multiple Wiimote connectivity, gesture recognition, and other +-- Wiimote-based functionality. +-- +-- The current implementation is rather incomplete. In particular: +-- +-- * Some Haskell functions (those related to rpt mode, rumble, leds) +-- had hard-coded values in them. Therefore, they implemented only a +-- very partial interface to their C counterparts. The new versions +-- should be tested and, if any other function is like this, +-- then exported properly. +-- +-- * Not all functions/wiimote fields are accessible. In particular, +-- acceleromoter info is in testing stage and no IR information +-- is exported. +-- +-- All in all, the code works quite well and is currently being used +-- to implement several real games. + module System.CWiid - (cwiidOpen, cwiidSetLed, cwiidSetRptMode, cwiidSetRumble, + ( + -- * Initialization + cwiidOpen, + CWiidWiimote, + -- * State + CWiidState(..), + -- * Reception mode + cwiidSetRptMode, + -- * Leds + CWiidLedFlag, + cwiidLed1, + cwiidLed2, + cwiidLed3, + cwiidLed4, + -- ** Led operations + cwiidSetLed, + combineCwiidLedFlag, + -- * Rumble + cwiidSetRumble, + -- * Buttons cwiidGetBtnState, cwiidIsBtnPushed, - cwiidLed1, cwiidLed2, cwiidLed3, cwiidLed4, combineCwiidLedFlag, cwiidBtn2, cwiidBtn1, cwiidBtnB, cwiidBtnA, cwiidBtnMinus, cwiidBtnHome, cwiidBtnLeft, cwiidBtnRight, cwiidBtnDown, cwiidBtnUp, cwiidBtnPlus, combineCwiidBtnFlag, diffCwiidBtnFlag, - CWiidBtnFlag(..), CWiidState(..), CWiidWiimote) where + CWiidBtnFlag(..), + -- * Accelerometers + cwiidGetAcc, + CWiidAcc(..) + ) where -- import Foreign.C.Error import Data.Bits @@ -47,8 +98,33 @@ return $ CWiidBdaddr b0 b1 b2 b3 b4 b5 -- typedef struct wiimote cwiid_wiimote_t; +-- +-- | A connection to an existing wiimote. Use 'cwiidOpen' to +-- connect to a wiimote and obtain one of these. newtype CWiidWiimote = CWiidWiimote { unCWiidWiimote :: Ptr () } +-- | Try to establish a connection to any existing Wiimote using +-- any existing bluetooth interface. +-- +-- The function returns 'Nothing' if there is no bluetooth interface +-- or if no wiimote can be located. If the connection succeeds, +-- a 'CWiidWiimote' is returned (inside a 'Just'), which can be used to +-- poll the wiimote using other functions. +-- +-- There is a default timeout of 5 seconds. +-- +-- * TODO: export cwiid_open_time and cwiid_close as well. + +-- wiimote = cwiid_open(&bdaddr, 0))) +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 + {-- struct cwiid_state { uint8_t rpt_mode; @@ -63,17 +139,88 @@ enum cwiid_error error; }; --} + +-- | The state of the wiimote. Use 'cwiidSetRptMode' to enable/disable +-- sensors. +-- +-- * FIXME: incomplete state +-- * FIXME: export get_state +data CWiidState = CWiidState + { rptMode :: Int, led :: Int, rumble :: Int, + battery :: Int, buttons :: Int, acc :: [Int] + } + deriving Show + +instance Storable CWiidState where + sizeOf = const #size struct cwiid_state + alignment = sizeOf + poke cwst (CWiidState rp l ru ba bu [ac0,ac1,ac2]) = do + (#poke struct cwiid_state, rpt_mode) cwst rp + (#poke struct cwiid_state, led) cwst l + (#poke struct cwiid_state, rumble) cwst ru + (#poke struct cwiid_state, battery) cwst ba + (#poke struct cwiid_state, buttons) cwst bu + (#poke struct cwiid_state, acc[0]) cwst (fromIntegral ac0 :: CUChar) + (#poke struct cwiid_state, acc[1]) cwst (fromIntegral ac1 :: CUChar) + (#poke struct cwiid_state, acc[2]) cwst (fromIntegral ac2 :: CUChar) + peek cwst = do + rp <- (#peek struct cwiid_state, rpt_mode) cwst + l <- (#peek struct cwiid_state, led) cwst + ru <- (#peek struct cwiid_state, rumble) cwst + ba <- (#peek struct cwiid_state, battery) cwst + bu <- (#peek struct cwiid_state, buttons) cwst + ac0 <- (#peek struct cwiid_state, acc[0]) cwst + ac1 <- (#peek struct cwiid_state, acc[1]) cwst + ac2 <- (#peek struct cwiid_state, acc[2]) cwst + return $ CWiidState rp l ru ba bu [ fromIntegral (ac0 :: CUChar) + , fromIntegral (ac1 :: CUChar) + , fromIntegral (ac2 :: CUChar)] + newtype CWiidLedFlag = CWiidLedFlag { unCWiidLedFlag :: Int } deriving (Eq, Show) + +-- | Flag with exactly led 1 enabled. Use 'combineCwiidLedFlag' +-- to create flags with several leds enabled. #{enum CWiidLedFlag, CWiidLedFlag , cwiidLed1 = CWIID_LED1_ON + } + +-- | Flag with exactly led 2 enabled. Use 'combineCwiidLedFlag' +-- to create flags with several leds enabled. +#{enum CWiidLedFlag, CWiidLedFlag , cwiidLed2 = CWIID_LED2_ON + } + +-- | Flag with exactly led 2 enabled. Use 'combineCwiidLedFlag' +-- to create flags with several leds enabled. +#{enum CWiidLedFlag, CWiidLedFlag , cwiidLed3 = CWIID_LED3_ON + } + +-- | Flag with exactly led 4 enabled. Use 'combineCwiidLedFlag' +-- to create flags with several leds enabled. +#{enum CWiidLedFlag, CWiidLedFlag , cwiidLed4 = CWIID_LED4_ON } + +-- | Enable/disable certain leds. +-- +-- Use 'cwiidLed1' .. 'cwiidLed4' together with 'combineCwiidLedFlag' +-- to create a flag with just the leds you want enabled and change +-- all at once with one operation. +cwiidSetLed :: CWiidWiimote -> CWiidLedFlag -> IO CInt +cwiidSetLed wm leds = c_cwiid_set_led handle ledUChars + where handle = unCWiidWiimote wm + ledUChars = fromIntegral (unCWiidLedFlag leds) + +-- | Combine several led flags into one led flag with those leds +-- enabled and all other leds disabled. + combineCwiidLedFlag :: [CWiidLedFlag] -> CWiidLedFlag combineCwiidLedFlag = CWiidLedFlag . foldr ((.|.) . unCWiidLedFlag) 0 +-- * Buttons + newtype CWiidBtnFlag = CWiidBtnFlag { unCWiidBtnFlag :: Int } deriving (Eq, Show) #{enum CWiidBtnFlag, CWiidBtnFlag @@ -89,58 +236,37 @@ , cwiidBtnUp = CWIID_BTN_UP , cwiidBtnPlus = CWIID_BTN_PLUS } + 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 } -- xxx 定義不足 - deriving Show -instance Storable CWiidState where - sizeOf = const #size struct cwiid_state - alignment = sizeOf - poke cwst (CWiidState rp l ru ba bu) = do - (#poke struct cwiid_state, rpt_mode) cwst rp - (#poke struct cwiid_state, led) cwst l - (#poke struct cwiid_state, rumble) cwst ru - (#poke struct cwiid_state, battery) cwst ba - (#poke struct cwiid_state, buttons) cwst bu - peek cwst = do - rp <- (#peek struct cwiid_state, rpt_mode) cwst - l <- (#peek struct cwiid_state, led) cwst - ru <- (#peek struct cwiid_state, rumble) cwst - ba <- (#peek struct cwiid_state, battery) cwst - bu <- (#peek struct cwiid_state, buttons) cwst - return $ CWiidState rp l ru ba bu +-- * Reception mode ------------------------------------------------------------------------------ --- Haskell land ---- --- wiimote = cwiid_open(&bdaddr, 0))) -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 +-- | Reception modes that select which sensors/wiimote activity +-- we listen to. +newtype CWiidRptMode = CWiidRptMode { unCWiidRptMode :: CUChar } + deriving (Eq, Show) -cwiidSetLed :: CWiidWiimote -> IO CInt -cwiidSetLed wm = c_cwiid_set_led handle 9 -- set on LED 1 and 4 +-- | Enable/disable reception of certain sensors. +-- Use 2 to enable buttons. +cwiidSetRptMode :: CWiidWiimote -> CUChar -> IO CInt +cwiidSetRptMode wm u = c_cwiid_set_rpt_mode handle u -- set BTN where handle = unCWiidWiimote wm -cwiidSetRptMode :: CWiidWiimote -> IO CInt -cwiidSetRptMode wm = c_cwiid_set_rpt_mode handle 2 -- set BTN - where handle = unCWiidWiimote wm +-- * Rumble cwiidSetRumble :: CWiidWiimote -> CUChar -> IO CInt cwiidSetRumble wm rm = c_cwiid_set_rumble handle rm where handle = unCWiidWiimote wm +-- * Buttons + +-- | Returns a mask with the buttons that are currently pushed. cwiidGetBtnState :: CWiidWiimote -> IO CWiidBtnFlag cwiidGetBtnState wm = alloca $ \wiState -> do @@ -149,9 +275,38 @@ return $ CWiidBtnFlag $ buttons ws where handle = unCWiidWiimote wm -cwiidIsBtnPushed :: CWiidBtnFlag -> CWiidBtnFlag -> Bool +-- | Returns 'True' if the button indicated by the flag is pushed, +-- 'False' otherwise. +-- +-- This is a pure function, so the first argument must be the +-- button flags as returned by 'cwiidGetBtnState'. +cwiidIsBtnPushed :: CWiidBtnFlag -- ^ The button flags as returned by 'cwiidGetBtnState'. + -> CWiidBtnFlag -- ^ A mask that flags the button/s that we want to check. + -> Bool -- ^ 'True' if they are all pushed, 'False' otherwise. cwiidIsBtnPushed flags btn = unCWiidBtnFlag flags .&. unCWiidBtnFlag btn == unCWiidBtnFlag btn + +-- * Accelerometres + +-- | Array of accelerometer information. It will always contain +-- exactly three elements. +-- +-- * TODO: provide a more informative and restrictive interface +-- with exactly three named Int (byte?) fields. +-- +newtype CWiidAcc = CWiidAcc { unCWiidAcc :: [Int] } + deriving (Eq, Show) + +-- | Obtain accelerometer information. +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 + +-- * Low-level bindings to C functions and back ----------------------------------------------------------------------------- -- C land diff --git a/hcwiid.cabal b/hcwiid.cabal --- a/hcwiid.cabal +++ b/hcwiid.cabal @@ -1,6 +1,6 @@ Name: hcwiid -Version: 0.0.3 -Author: Kiwamu Okabe +Version: 0.0.4 +Author: Kiwamu Okabe , Ivan Perez Maintainer: Ivan Perez License: GPL-2 License-File: COPYING diff --git a/test/Test.hs b/test/Test.hs --- a/test/Test.hs +++ b/test/Test.hs @@ -10,8 +10,9 @@ putStrLn "Put Wiimote in discoverable mode now (press 1+2)..." (Just wm) <- cwiidOpen putStrLn "found!" - _ <- cwiidSetLed wm - _ <- cwiidSetRptMode wm + _ <- cwiidSetLed wm (combineCwiidLedFlag [cwiidLed1, cwiidLed3]) + _ <- cwiidSetRptMode wm 7 _ <- forever $ do _ <- usleep 300000 cwiidGetBtnState wm >>= print + cwiidGetAcc wm >>= print return () -- not reach