44 lines
No EOL
2 KiB
Haskell
44 lines
No EOL
2 KiB
Haskell
{-# LANGUAGE DeriveDataTypeable #-}
|
|
|
|
module WiimotePlayer ( WiimotePlayer(..)
|
|
, newWiimotePlayer
|
|
) where
|
|
|
|
import Control.Monad
|
|
import Data.Bits
|
|
import Data.Ratio ((%))
|
|
import Data.Typeable
|
|
import HWiid
|
|
|
|
import Player
|
|
|
|
|
|
data WiimotePlayer = WiimotePlayer Wiimote
|
|
deriving (Typeable, Show)
|
|
|
|
instance Player WiimotePlayer where
|
|
playerUpdate (WiimotePlayer wiimote) tank = do
|
|
buttons <- hwiidGetState wiimote >>= return . stateButtons
|
|
messages <- hwiidGetMesg wiimote
|
|
|
|
let shoot = any (\m -> (mesgType m == hwiidMesgTypeButton) && (test (mesgButtons m) hwiidButtonB)) $ messages
|
|
x = (if (test buttons hwiidButtonLeft) then (-1) else 0) + (if (test buttons hwiidButtonRight) then 1 else 0)
|
|
y = (if (test buttons hwiidButtonDown) then (-1) else 0) + (if (test buttons hwiidButtonUp) then 1 else 0)
|
|
--ax = aimx - (fromRational . toRational . tankX $ tank)
|
|
--ay = aimy - (fromRational . toRational . tankY $ tank)
|
|
move = (x /= 0 || y /= 0)
|
|
|
|
angle = if move then Just $ fromRational $ round ((atan2 y x)*1000000*180/pi)%1000000 else Nothing
|
|
--aangle = if (ax /= 0 || ay /= 0) then Just $ fromRational $ round ((atan2 ay ax)*1000000*180/pi)%1000000 else Nothing
|
|
return (WiimotePlayer wiimote, angle, move, Nothing, shoot)
|
|
|
|
|
|
newWiimotePlayer :: IO WiimotePlayer
|
|
newWiimotePlayer = do
|
|
wiimote <- hwiidOpen bdAddrAny (hwiidFlagMesgInterface .|. hwiidFlagNonblock)
|
|
when (wiimote == nullWiimote) $ fail "Wiimote error"
|
|
hwiidSetReportMode wiimote hwiidReportButtons
|
|
return $ WiimotePlayer wiimote
|
|
|
|
test :: (Bits a) => a -> a -> Bool
|
|
test field bits = (field .&. bits) == bits |