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

module HWiid ( BDAddr(..)
             , Wiimote
             , WiimoteState(..)
             , nullWiimote
             , bdAddrAny
             , hwiidLed1
             , hwiidLed2
             , hwiidLed3
             , hwiidLed4
             , hwiidReportStatus
             , hwiidReportButtons
             , hwiidOpen
             , hwiidOpenTimeout
             , hwiidClose
             , hwiidGetState
             , hwiidSetReportMode
             , hwiidSetLed
             , hwiidButton2
             , hwiidButton1
             , hwiidButtonB
             , hwiidButtonA
             , hwiidButtonMinus
             , hwiidButtonHome
             , hwiidButtonLeft
             , hwiidButtonRight
             , hwiidButtonDown
             , hwiidButtonUp
             , hwiidButtonPlus
             , hwiidNunchukButtonZ
             , hwiidNunchukButtonC
             ) where


import Data.Word
import Foreign.C.Types
import Foreign.Marshal.Alloc (alloca)
import Foreign.Marshal.Utils (with)
import Foreign.Ptr
import Foreign.Storable


#include <cwiid.h>


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 WiimoteState = WiimoteState
                  { stateButtons :: Word16
                  } deriving (Eq, Show)

instance Storable WiimoteState where
    sizeOf _ = (#size struct cwiid_state)
    alignment _ = alignment (undefined :: CInt)
    
    peek state = do
      buttons <- (#peek struct cwiid_state, buttons) state
      return $ WiimoteState (buttons)
    
    poke state (WiimoteState (buttons)) = do
                                 (#poke struct cwiid_state, buttons) state buttons


newtype Wiimote = Wiimote (Ptr Wiimote) deriving (Eq, Ord, Show, Storable)

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)

hwiidReportStatus :: Word8
hwiidReportStatus = (#const CWIID_RPT_STATUS)

hwiidReportButtons :: Word8
hwiidReportButtons = (#const CWIID_RPT_BTN)


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)


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