path: root/src/HWiid.hsc

{-# LANGUAGE ForeignFunctionInterface, DeriveDataTypeable, GeneralizedNewtypeDeriving #-}

module HWiid ( BDAddr(..)
             , Wiimote
             , WiimoteIRSource(..)
             , WiimoteState(..)
             , WiimoteExtType
             , WiimoteExtState(..)
             , WiimoteMesgType
             , WiimoteMesg(..)
             , WiimoteAccCal(..)
             , nullWiimote
             , bdAddrAny
             , flagMesgInterface
             , flagNonblock
             , reportStatus
             , reportButtons
             , reportAcc
             , reportIR
             , reportNunchuk
             , reportExt
             , led1
             , led2
             , led3
             , led4
             , button2
             , button1
             , buttonB
             , buttonA
             , buttonMinus
             , buttonHome
             , buttonLeft
             , buttonRight
             , buttonDown
             , buttonUp
             , buttonPlus
             , nunchukButtonZ
             , nunchukButtonC
             , irMaxX
             , irMaxY
             , mesgTypeStatus
             , mesgTypeButton
             , extNone
             , extNunchuk
             , open
             , openTimeout
             , close
             , getState
             , setReportMode
             , setLed
             , getMesg
             , getAccCal
             ) 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>

flagMesgInterface :: CInt
flagMesgInterface = (#const CWIID_FLAG_MESG_IFC)

flagNonblock :: CInt
flagNonblock = (#const CWIID_FLAG_NONBLOCK)


reportStatus :: Word8
reportStatus = (#const CWIID_RPT_STATUS)

reportButtons :: Word8
reportButtons = (#const CWIID_RPT_BTN)

reportAcc :: Word8
reportAcc = (#const CWIID_RPT_ACC)

reportIR :: Word8
reportIR = (#const CWIID_RPT_IR)

reportNunchuk :: Word8
reportNunchuk = (#const CWIID_RPT_NUNCHUK)

reportExt :: Word8
reportExt = reportNunchuk


led1 :: Word8
led1 = (#const CWIID_LED1_ON)

led2 :: Word8
led2 = (#const CWIID_LED2_ON)

led3 :: Word8
led3 = (#const CWIID_LED3_ON)

led4 :: Word8
led4 = (#const CWIID_LED4_ON)


button2 :: Word16
button2 = (#const CWIID_BTN_2)

button1 :: Word16
button1 = (#const CWIID_BTN_1)

buttonB :: Word16
buttonB = (#const CWIID_BTN_B)

buttonA :: Word16
buttonA = (#const CWIID_BTN_A)

buttonMinus :: Word16
buttonMinus = (#const CWIID_BTN_MINUS)

buttonHome :: Word16
buttonHome = (#const CWIID_BTN_HOME)

buttonLeft :: Word16
buttonLeft = (#const CWIID_BTN_LEFT)

buttonRight :: Word16
buttonRight = (#const CWIID_BTN_RIGHT)

buttonDown :: Word16
buttonDown = (#const CWIID_BTN_DOWN)

buttonUp :: Word16
buttonUp = (#const CWIID_BTN_UP)

buttonPlus :: Word16
buttonPlus = (#const CWIID_BTN_PLUS)


nunchukButtonZ :: Word16
nunchukButtonZ = (#const CWIID_NUNCHUK_BTN_Z)

nunchukButtonC :: Word16
nunchukButtonC = (#const CWIID_NUNCHUK_BTN_C)


irMaxX :: CInt
irMaxX = (#const CWIID_IR_X_MAX)

irMaxY :: CInt
irMaxY = (#const CWIID_IR_Y_MAX)


type WiimoteMesgType = (#type enum cwiid_mesg_type)

mesgTypeStatus :: WiimoteMesgType
mesgTypeStatus = (#const CWIID_MESG_STATUS)

mesgTypeButton :: WiimoteMesgType
mesgTypeButton = (#const CWIID_MESG_BTN)


type WiimoteExtType = (#type enum cwiid_ext_type)

extNone :: WiimoteExtType
extNone = (#const CWIID_EXT_NONE)

extNunchuk :: WiimoteExtType
extNunchuk = (#const CWIID_EXT_NUNCHUK)


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
    , stateAccX      :: Word8
    , stateAccY      :: Word8
    , stateAccZ      :: Word8
    , stateIRSources :: [WiimoteIRSource]
    , stateExt       :: WiimoteExtState
    } 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
      accX      <- (#peek struct cwiid_state, acc[0]) state
      accY      <- (#peek struct cwiid_state, acc[1]) state
      accZ      <- (#peek struct cwiid_state, acc[2]) state
      irSources <- peekArray (#const CWIID_IR_SRC_COUNT) $ (#ptr struct cwiid_state, ir_src) state
      exttype   <- (#peek struct cwiid_state, ext_type) state
      extstate  <- peekExtState exttype $ (#ptr struct cwiid_state, ext) state
      return $ WiimoteState led rumble battery buttons accX accY accZ (filter (\src -> (irValid src) /= 0) irSources) extstate
    
    poke _ _ = fail "Can't write WiimoteState"

data WiimoteMesg = WiimoteStatusMesg
    { mesgType          :: WiimoteMesgType
    , mesgBattery       :: Word8
    }
                 | WiimoteButtonMesg
    { mesgType          :: WiimoteMesgType
    , mesgButtons       :: Word16
    }
                 | WiimoteMesgOther
    { mesgType          :: WiimoteMesgType
    }
                   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 == mesgTypeStatus -> do
                                battery <- (#peek struct cwiid_status_mesg, battery) mesg
                                return $ WiimoteStatusMesg mesgtype battery
           | mesgtype == mesgTypeButton -> do
                                buttons <- (#peek struct cwiid_btn_mesg, buttons) mesg
                                return $ WiimoteButtonMesg mesgtype buttons
           | otherwise -> return $ WiimoteMesgOther mesgtype
                                    
    
    poke _ _ = fail "Can't write WiimoteMesg"


data WiimoteExtState = WiimoteNunchukState
    { extType           :: WiimoteExtType
    , extNunchukStickX  :: Word8
    , extNunchukStickY  :: Word8
    , extNunchukButtons :: Word8
    }
                     | WiimoteOtherState
    { extType           :: WiimoteExtType
    }
                       deriving (Eq, Show)

peekExtState :: WiimoteExtType -> Ptr WiimoteExtState -> IO WiimoteExtState
peekExtState exttype state
    | exttype == extNunchuk = do
  posx <- (#peek struct nunchuk_state, stick[0]) state
  posy <- (#peek struct nunchuk_state, stick[1]) state
  buttons <- (#peek struct nunchuk_state, buttons) state
  return $ WiimoteNunchukState exttype posx posy buttons
    | otherwise = return $ WiimoteOtherState exttype


data WiimoteAccCal = WiimoteAccCal
    { accCalZeroX :: Word8
    , accCalZeroY :: Word8
    , accCalZeroZ :: Word8
    , accCalOneX  :: Word8
    , accCalOneY  :: Word8
    , accCalOneZ  :: Word8
    }
                     deriving (Eq, Show)

instance Storable WiimoteAccCal where
    sizeOf _ = (#size struct acc_cal)
    alignment _ = alignment (undefined :: CInt)
    
    peek cal = do
      zerox <- (#peek struct acc_cal, zero[0]) cal
      zeroy <- (#peek struct acc_cal, zero[1]) cal
      zeroz <- (#peek struct acc_cal, zero[2]) cal
      onex <- (#peek struct acc_cal, one[0]) cal
      oney <- (#peek struct acc_cal, one[1]) cal
      onez <- (#peek struct acc_cal, one[2]) cal
      
      return $ WiimoteAccCal zerox zeroy zeroz onex oney onez
    
    poke _ _ = fail "Can't write WiimoteAccCal"
    

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

openTimeout :: BDAddr -> CInt -> CInt -> IO Wiimote
openTimeout addr flags timeout = with addr $ \addrptr -> cwiid_open_timeout addrptr flags timeout

defaultTimeout :: CInt
defaultTimeout = 5

open :: BDAddr -> CInt -> IO Wiimote
open addr flags = openTimeout addr flags defaultTimeout

foreign import ccall unsafe "cwiid.h cwiid_close"
        close :: Wiimote -> IO CInt

foreign import ccall unsafe "cwiid.h cwiid_get_state"
        cwiid_get_state :: Wiimote -> Ptr WiimoteState -> IO CInt

getState :: Wiimote -> IO WiimoteState
getState wiimote = alloca $ \state -> do
                     cwiid_get_state wiimote state
                     peek state

foreign import ccall unsafe "cwiid.h cwiid_set_rpt_mode"
        setReportMode :: Wiimote -> Word8 -> IO CInt

foreign import ccall unsafe "cwiid.h cwiid_set_led"
        setLed :: 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

getMesg :: Wiimote -> IO [WiimoteMesg]
getMesg 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 []
foreign import ccall unsafe "cwiid.h cwiid_get_acc_cal"
        cwiid_get_acc_cal :: Wiimote -> WiimoteExtType -> Ptr WiimoteAccCal -> IO CInt

getAccCal wiimote exttype = alloca $ \calptr -> do
                              cwiid_get_acc_cal wiimote exttype calptr
                              cal <- peek calptr
                              return cal