path: root/src/HWiid.hsc

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

module HWiid ( BDAddr(..)
             , Wiimote
             , WiimoteIRSource(..)
             , WiimoteState(..)
             , WiimoteExtState(..)
             , WiimoteMesg(..)
             , nullWiimote
             , bdAddrAny
             , hwiidFlagMesgInterface
             , hwiidFlagNonblock
             , hwiidReportStatus
             , hwiidReportButtons
             , hwiidReportAcc
             , hwiidReportIR
             , hwiidReportNunchuk
             , hwiidReportExt
             , hwiidLed1
             , hwiidLed2
             , hwiidLed3
             , hwiidLed4
             , hwiidButton2
             , hwiidButton1
             , hwiidButtonB
             , hwiidButtonA
             , hwiidButtonMinus
             , hwiidButtonHome
             , hwiidButtonLeft
             , hwiidButtonRight
             , hwiidButtonDown
             , hwiidButtonUp
             , hwiidButtonPlus
             , hwiidNunchukButtonZ
             , hwiidNunchukButtonC
             , hwiidIRMaxX
             , hwiidIRMaxY
             , hwiidMesgTypeStatus
             , hwiidMesgTypeButton
             , hwiidExtNone
             , hwiidExtNunchuk
             , hwiidOpen
             , hwiidOpenTimeout
             , hwiidClose
             , hwiidGetState
             , hwiidSetReportMode
             , hwiidSetLed
             , hwiidGetMesg
             ) 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>

hwiidFlagMesgInterface :: CInt
hwiidFlagMesgInterface = (#const CWIID_FLAG_MESG_IFC)

hwiidFlagNonblock :: CInt
hwiidFlagNonblock = (#const CWIID_FLAG_NONBLOCK)


hwiidReportStatus :: Word8
hwiidReportStatus = (#const CWIID_RPT_STATUS)

hwiidReportButtons :: Word8
hwiidReportButtons = (#const CWIID_RPT_BTN)

hwiidReportAcc :: Word8
hwiidReportAcc = (#const CWIID_RPT_ACC)

hwiidReportIR :: Word8
hwiidReportIR = (#const CWIID_RPT_IR)

hwiidReportNunchuk :: Word8
hwiidReportNunchuk = (#const CWIID_RPT_NUNCHUK)

hwiidReportExt :: Word8
hwiidReportExt = hwiidReportNunchuk


hwiidLed1 :: Word8
hwiidLed1 = (#const CWIID_LED1_ON)

hwiidLed2 :: Word8
hwiidLed2 = (#const CWIID_LED2_ON)

hwiidLed3 :: Word8
hwiidLed3 = (#const CWIID_LED3_ON)

hwiidLed4 :: Word8
hwiidLed4 = (#const CWIID_LED4_ON)


hwiidButton2 :: Word16
hwiidButton2 = (#const CWIID_BTN_2)

hwiidButton1 :: Word16
hwiidButton1 = (#const CWIID_BTN_1)

hwiidButtonB :: Word16
hwiidButtonB = (#const CWIID_BTN_B)

hwiidButtonA :: Word16
hwiidButtonA = (#const CWIID_BTN_A)

hwiidButtonMinus :: Word16
hwiidButtonMinus = (#const CWIID_BTN_MINUS)

hwiidButtonHome :: Word16
hwiidButtonHome = (#const CWIID_BTN_HOME)

hwiidButtonLeft :: Word16
hwiidButtonLeft = (#const CWIID_BTN_LEFT)

hwiidButtonRight :: Word16
hwiidButtonRight = (#const CWIID_BTN_RIGHT)

hwiidButtonDown :: Word16
hwiidButtonDown = (#const CWIID_BTN_DOWN)

hwiidButtonUp :: Word16
hwiidButtonUp = (#const CWIID_BTN_UP)

hwiidButtonPlus :: Word16
hwiidButtonPlus = (#const CWIID_BTN_PLUS)


hwiidNunchukButtonZ :: Word16
hwiidNunchukButtonZ = (#const CWIID_NUNCHUK_BTN_Z)

hwiidNunchukButtonC :: Word16
hwiidNunchukButtonC = (#const CWIID_NUNCHUK_BTN_C)


hwiidIRMaxX :: CInt
hwiidIRMaxX = (#const CWIID_IR_X_MAX)

hwiidIRMaxY :: CInt
hwiidIRMaxY = (#const CWIID_IR_Y_MAX)


hwiidMesgTypeStatus :: (#type enum cwiid_mesg_type)
hwiidMesgTypeStatus = (#const CWIID_MESG_STATUS)

hwiidMesgTypeButton :: (#type enum cwiid_mesg_type)
hwiidMesgTypeButton = (#const CWIID_MESG_BTN)


hwiidExtNone :: (#type enum cwiid_ext_type)
hwiidExtNone = (#const CWIID_EXT_NONE)

hwiidExtNunchuk :: (#type enum cwiid_ext_type)
hwiidExtNunchuk = (#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          :: (#type enum cwiid_mesg_type)
    , mesgBattery       :: Word8
    }
                 | WiimoteButtonMesg
    { mesgType          :: (#type enum cwiid_mesg_type)
    , mesgButtons       :: Word16
    }
                 | WiimoteMesgOther
    { mesgType          :: (#type enum cwiid_mesg_type)
    }
                   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 == hwiidMesgTypeStatus -> do
                                battery <- (#peek struct cwiid_status_mesg, battery) mesg
                                return $ WiimoteStatusMesg mesgtype battery
           | mesgtype == hwiidMesgTypeButton -> 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           :: (#type enum cwiid_ext_type)
    , extNunchukStickX  :: Word8
    , extNunchukStickY  :: Word8
    , extNunchukButtons :: Word8
    }
                     | WiimoteOtherState
    { extType           :: (#type enum cwiid_ext_type)
    }
                       deriving (Eq, Show)

peekExtState :: (#type enum cwiid_ext_type) -> Ptr WiimoteExtState -> IO WiimoteExtState
peekExtState exttype state
    | exttype == hwiidExtNunchuk = 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
    

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

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

defaultTimeout :: CInt
defaultTimeout = 5

hwiidOpen :: BDAddr -> CInt -> IO Wiimote
hwiidOpen addr flags = hwiidOpenTimeout addr flags defaultTimeout

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

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

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

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

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

hwiidGetMesg :: Wiimote -> IO [WiimoteMesg]
hwiidGetMesg 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 []