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

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


import Data.Bits
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)


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)


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

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



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


data WiimoteMesg = WiimoteStatusMesg
    { mesgType          :: (#type enum cwiid_mesg_type)
    , mesgBattery       :: Word8
    , mesgExtensionType :: (#type enum cwiid_ext_type)
    }
                 | WiimoteButtonMesg
    { mesgType          :: (#type enum cwiid_mesg_type)
    , mesgButtons       :: Word16
    }
                 | WiimoteMesgUnknown
                   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
                                exttype <- (#peek struct cwiid_status_mesg, ext_type) mesg
                                return $ WiimoteStatusMesg mesgtype battery exttype
           | mesgtype == hwiidMesgTypeButton -> do
                                buttons <- (#peek struct cwiid_btn_mesg, buttons) mesg
                                return $ WiimoteButtonMesg mesgtype buttons
           | otherwise -> return WiimoteMesgUnknown
                                    
    
    poke _ _ = error "Can't write WiimoteMesg"


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 []