Added IR support

src/HWiid.hsc

@@ -2,6 +2,7 @@
 
 module HWiid ( BDAddr(..)
              , Wiimote
+             , WiimoteIRSource(..)
              , WiimoteState(..)
              , WiimoteMesg(..)
              , nullWiimote
@@ -10,6 +11,7 @@ module HWiid ( BDAddr(..)
              , hwiidFlagNonblock
              , hwiidReportStatus
              , hwiidReportButtons
+             , hwiidReportIR
              , hwiidLed1
              , hwiidLed2
              , hwiidLed3
@@ -40,6 +42,7 @@ module HWiid ( BDAddr(..)
 
 
 import Data.Bits
+import Data.Int
 import Data.Typeable
 import Data.Word
 import Foreign.C.Types
@@ -65,6 +68,9 @@ 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)
@@ -156,8 +162,32 @@ 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
-    { stateButtons :: Word16
+    { stateLed       :: Word8
+    , stateRumble    :: Word8
+    , stateBattery   :: Word8
+    , stateButtons   :: Word16
+    , stateIRSources :: [WiimoteIRSource]
     } deriving (Eq, Show)
 
 instance Storable WiimoteState where
@@ -165,12 +195,14 @@ instance Storable WiimoteState where
     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
-      return $ WiimoteState (buttons)
+      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 state (WiimoteState (buttons)) = do
+    poke _ _ = fail "Can't write WiimoteState"
-                                 (#poke struct cwiid_state, buttons) state buttons
-
 
 data WiimoteMesg = WiimoteStatusMesg
     { mesgType          :: (#type enum cwiid_mesg_type)
@@ -182,6 +214,8 @@ data WiimoteMesg = WiimoteStatusMesg
     , mesgButtons       :: Word16
     }
                  | WiimoteMesgUnknown
+    { mesgType          :: (#type enum cwiid_mesg_type)
+    }
                    deriving (Eq, Show)
 
 instance Storable WiimoteMesg where
@@ -199,10 +233,10 @@ instance Storable WiimoteMesg where
            | mesgtype == hwiidMesgTypeButton -> do
                                 buttons <- (#peek struct cwiid_btn_mesg, buttons) mesg
                                 return $ WiimoteButtonMesg mesgtype buttons
-           | otherwise -> return WiimoteMesgUnknown
+           | otherwise -> return $ WiimoteMesgUnknown mesgtype
                                     
     
-    poke _ _ = error "Can't write WiimoteMesg"
+    poke _ _ = fail "Can't write WiimoteMesg"
 
 
 newtype Wiimote = Wiimote (Ptr Wiimote) deriving (Eq, Ord, Show, Storable)