{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE KindSignatures #-}
module Device.Nintendo.Switch.Controller where
import Data.Attoparsec.ByteString (IResult(Done), Parser, anyWord8, parse, take, word8)
import Data.Bits ((.&.), (.|.), Bits, shiftL, shiftR)
import Data.Int (Int16)
import Data.IORef (IORef)
import Data.Word (Word8, Word16)
import Prelude hiding (take)
import Data.ByteString (ByteString)
import System.HIDAPI (Device)
import Device.Nintendo.Switch.Utils (tripleParser, tripleZipWith)
data ControllerType
= LeftJoyCon
| RightJoyCon
| ProController
deriving (ControllerType -> ControllerType -> Bool
(ControllerType -> ControllerType -> Bool)
-> (ControllerType -> ControllerType -> Bool) -> Eq ControllerType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ControllerType -> ControllerType -> Bool
$c/= :: ControllerType -> ControllerType -> Bool
== :: ControllerType -> ControllerType -> Bool
$c== :: ControllerType -> ControllerType -> Bool
Eq, ReadPrec [ControllerType]
ReadPrec ControllerType
Int -> ReadS ControllerType
ReadS [ControllerType]
(Int -> ReadS ControllerType)
-> ReadS [ControllerType]
-> ReadPrec ControllerType
-> ReadPrec [ControllerType]
-> Read ControllerType
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ControllerType]
$creadListPrec :: ReadPrec [ControllerType]
readPrec :: ReadPrec ControllerType
$creadPrec :: ReadPrec ControllerType
readList :: ReadS [ControllerType]
$creadList :: ReadS [ControllerType]
readsPrec :: Int -> ReadS ControllerType
$creadsPrec :: Int -> ReadS ControllerType
Read, Int -> ControllerType -> ShowS
[ControllerType] -> ShowS
ControllerType -> String
(Int -> ControllerType -> ShowS)
-> (ControllerType -> String)
-> ([ControllerType] -> ShowS)
-> Show ControllerType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ControllerType] -> ShowS
$cshowList :: [ControllerType] -> ShowS
show :: ControllerType -> String
$cshow :: ControllerType -> String
showsPrec :: Int -> ControllerType -> ShowS
$cshowsPrec :: Int -> ControllerType -> ShowS
Show)
data Controller (t :: ControllerType) =
Controller
{ Controller t -> Device
handle :: Device
, Controller t -> IORef Word8
counter :: IORef Word8
, Controller t -> Calibration
calibration :: Calibration
}
data Calibration =
Calibration
{ Calibration -> (Float, Float, Float)
accCoeffs :: (Float, Float, Float)
, Calibration -> (Float, Float, Float)
gyroCoeffs :: (Float, Float, Float)
, Calibration -> StickCalibration
leftStickCal :: StickCalibration
, Calibration -> StickCalibration
rightStickCal :: StickCalibration
}
deriving (Calibration -> Calibration -> Bool
(Calibration -> Calibration -> Bool)
-> (Calibration -> Calibration -> Bool) -> Eq Calibration
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Calibration -> Calibration -> Bool
$c/= :: Calibration -> Calibration -> Bool
== :: Calibration -> Calibration -> Bool
$c== :: Calibration -> Calibration -> Bool
Eq, ReadPrec [Calibration]
ReadPrec Calibration
Int -> ReadS Calibration
ReadS [Calibration]
(Int -> ReadS Calibration)
-> ReadS [Calibration]
-> ReadPrec Calibration
-> ReadPrec [Calibration]
-> Read Calibration
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Calibration]
$creadListPrec :: ReadPrec [Calibration]
readPrec :: ReadPrec Calibration
$creadPrec :: ReadPrec Calibration
readList :: ReadS [Calibration]
$creadList :: ReadS [Calibration]
readsPrec :: Int -> ReadS Calibration
$creadsPrec :: Int -> ReadS Calibration
Read, Int -> Calibration -> ShowS
[Calibration] -> ShowS
Calibration -> String
(Int -> Calibration -> ShowS)
-> (Calibration -> String)
-> ([Calibration] -> ShowS)
-> Show Calibration
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Calibration] -> ShowS
$cshowList :: [Calibration] -> ShowS
show :: Calibration -> String
$cshow :: Calibration -> String
showsPrec :: Int -> Calibration -> ShowS
$cshowsPrec :: Int -> Calibration -> ShowS
Show)
data RawSensorCalibration =
RawSensorCalibration
{ RawSensorCalibration -> (Int16, Int16, Int16)
rawAcc :: (Int16, Int16, Int16)
, RawSensorCalibration -> (Int16, Int16, Int16)
rawAccSensitivity :: (Int16, Int16, Int16)
, RawSensorCalibration -> (Int16, Int16, Int16)
rawGyro :: (Int16, Int16, Int16)
, RawSensorCalibration -> (Int16, Int16, Int16)
rawGyroSensitivity :: (Int16, Int16, Int16)
}
deriving (RawSensorCalibration -> RawSensorCalibration -> Bool
(RawSensorCalibration -> RawSensorCalibration -> Bool)
-> (RawSensorCalibration -> RawSensorCalibration -> Bool)
-> Eq RawSensorCalibration
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RawSensorCalibration -> RawSensorCalibration -> Bool
$c/= :: RawSensorCalibration -> RawSensorCalibration -> Bool
== :: RawSensorCalibration -> RawSensorCalibration -> Bool
$c== :: RawSensorCalibration -> RawSensorCalibration -> Bool
Eq, ReadPrec [RawSensorCalibration]
ReadPrec RawSensorCalibration
Int -> ReadS RawSensorCalibration
ReadS [RawSensorCalibration]
(Int -> ReadS RawSensorCalibration)
-> ReadS [RawSensorCalibration]
-> ReadPrec RawSensorCalibration
-> ReadPrec [RawSensorCalibration]
-> Read RawSensorCalibration
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RawSensorCalibration]
$creadListPrec :: ReadPrec [RawSensorCalibration]
readPrec :: ReadPrec RawSensorCalibration
$creadPrec :: ReadPrec RawSensorCalibration
readList :: ReadS [RawSensorCalibration]
$creadList :: ReadS [RawSensorCalibration]
readsPrec :: Int -> ReadS RawSensorCalibration
$creadsPrec :: Int -> ReadS RawSensorCalibration
Read, Int -> RawSensorCalibration -> ShowS
[RawSensorCalibration] -> ShowS
RawSensorCalibration -> String
(Int -> RawSensorCalibration -> ShowS)
-> (RawSensorCalibration -> String)
-> ([RawSensorCalibration] -> ShowS)
-> Show RawSensorCalibration
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RawSensorCalibration] -> ShowS
$cshowList :: [RawSensorCalibration] -> ShowS
show :: RawSensorCalibration -> String
$cshow :: RawSensorCalibration -> String
showsPrec :: Int -> RawSensorCalibration -> ShowS
$cshowsPrec :: Int -> RawSensorCalibration -> ShowS
Show)
data RawStickCalibration =
RawStickCalibration
{ RawStickCalibration -> Word16
rawMinusX :: Word16
, RawStickCalibration -> Word16
rawCenterX :: Word16
, RawStickCalibration -> Word16
rawPlusX :: Word16
, RawStickCalibration -> Word16
rawMinusY :: Word16
, RawStickCalibration -> Word16
rawCenterY :: Word16
, RawStickCalibration -> Word16
rawPlusY :: Word16
}
deriving (RawStickCalibration -> RawStickCalibration -> Bool
(RawStickCalibration -> RawStickCalibration -> Bool)
-> (RawStickCalibration -> RawStickCalibration -> Bool)
-> Eq RawStickCalibration
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RawStickCalibration -> RawStickCalibration -> Bool
$c/= :: RawStickCalibration -> RawStickCalibration -> Bool
== :: RawStickCalibration -> RawStickCalibration -> Bool
$c== :: RawStickCalibration -> RawStickCalibration -> Bool
Eq, ReadPrec [RawStickCalibration]
ReadPrec RawStickCalibration
Int -> ReadS RawStickCalibration
ReadS [RawStickCalibration]
(Int -> ReadS RawStickCalibration)
-> ReadS [RawStickCalibration]
-> ReadPrec RawStickCalibration
-> ReadPrec [RawStickCalibration]
-> Read RawStickCalibration
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RawStickCalibration]
$creadListPrec :: ReadPrec [RawStickCalibration]
readPrec :: ReadPrec RawStickCalibration
$creadPrec :: ReadPrec RawStickCalibration
readList :: ReadS [RawStickCalibration]
$creadList :: ReadS [RawStickCalibration]
readsPrec :: Int -> ReadS RawStickCalibration
$creadsPrec :: Int -> ReadS RawStickCalibration
Read, Int -> RawStickCalibration -> ShowS
[RawStickCalibration] -> ShowS
RawStickCalibration -> String
(Int -> RawStickCalibration -> ShowS)
-> (RawStickCalibration -> String)
-> ([RawStickCalibration] -> ShowS)
-> Show RawStickCalibration
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RawStickCalibration] -> ShowS
$cshowList :: [RawStickCalibration] -> ShowS
show :: RawStickCalibration -> String
$cshow :: RawStickCalibration -> String
showsPrec :: Int -> RawStickCalibration -> ShowS
$cshowsPrec :: Int -> RawStickCalibration -> ShowS
Show)
data RawCalibration =
RawCalibration
{ RawCalibration -> RawStickCalibration
rawLeftStickCal :: RawStickCalibration
, RawCalibration -> RawStickCalibration
rawRightStickCal :: RawStickCalibration
, RawCalibration -> RawSensorCalibration
rawSensorCal :: RawSensorCalibration
}
deriving (RawCalibration -> RawCalibration -> Bool
(RawCalibration -> RawCalibration -> Bool)
-> (RawCalibration -> RawCalibration -> Bool) -> Eq RawCalibration
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RawCalibration -> RawCalibration -> Bool
$c/= :: RawCalibration -> RawCalibration -> Bool
== :: RawCalibration -> RawCalibration -> Bool
$c== :: RawCalibration -> RawCalibration -> Bool
Eq, ReadPrec [RawCalibration]
ReadPrec RawCalibration
Int -> ReadS RawCalibration
ReadS [RawCalibration]
(Int -> ReadS RawCalibration)
-> ReadS [RawCalibration]
-> ReadPrec RawCalibration
-> ReadPrec [RawCalibration]
-> Read RawCalibration
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RawCalibration]
$creadListPrec :: ReadPrec [RawCalibration]
readPrec :: ReadPrec RawCalibration
$creadPrec :: ReadPrec RawCalibration
readList :: ReadS [RawCalibration]
$creadList :: ReadS [RawCalibration]
readsPrec :: Int -> ReadS RawCalibration
$creadsPrec :: Int -> ReadS RawCalibration
Read, Int -> RawCalibration -> ShowS
[RawCalibration] -> ShowS
RawCalibration -> String
(Int -> RawCalibration -> ShowS)
-> (RawCalibration -> String)
-> ([RawCalibration] -> ShowS)
-> Show RawCalibration
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RawCalibration] -> ShowS
$cshowList :: [RawCalibration] -> ShowS
show :: RawCalibration -> String
$cshow :: RawCalibration -> String
showsPrec :: Int -> RawCalibration -> ShowS
$cshowsPrec :: Int -> RawCalibration -> ShowS
Show)
data StickCalibration =
StickCalibration
{ StickCalibration -> Float
deadCenter :: Float
, StickCalibration -> Float
deadOuter :: Float
, StickCalibration -> Float
minusX :: Float
, StickCalibration -> Float
centerX :: Float
, StickCalibration -> Float
plusX :: Float
, StickCalibration -> Float
minusY :: Float
, StickCalibration -> Float
centerY :: Float
, StickCalibration -> Float
plusY :: Float
}
deriving (StickCalibration -> StickCalibration -> Bool
(StickCalibration -> StickCalibration -> Bool)
-> (StickCalibration -> StickCalibration -> Bool)
-> Eq StickCalibration
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StickCalibration -> StickCalibration -> Bool
$c/= :: StickCalibration -> StickCalibration -> Bool
== :: StickCalibration -> StickCalibration -> Bool
$c== :: StickCalibration -> StickCalibration -> Bool
Eq, ReadPrec [StickCalibration]
ReadPrec StickCalibration
Int -> ReadS StickCalibration
ReadS [StickCalibration]
(Int -> ReadS StickCalibration)
-> ReadS [StickCalibration]
-> ReadPrec StickCalibration
-> ReadPrec [StickCalibration]
-> Read StickCalibration
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StickCalibration]
$creadListPrec :: ReadPrec [StickCalibration]
readPrec :: ReadPrec StickCalibration
$creadPrec :: ReadPrec StickCalibration
readList :: ReadS [StickCalibration]
$creadList :: ReadS [StickCalibration]
readsPrec :: Int -> ReadS StickCalibration
$creadsPrec :: Int -> ReadS StickCalibration
Read, Int -> StickCalibration -> ShowS
[StickCalibration] -> ShowS
StickCalibration -> String
(Int -> StickCalibration -> ShowS)
-> (StickCalibration -> String)
-> ([StickCalibration] -> ShowS)
-> Show StickCalibration
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StickCalibration] -> ShowS
$cshowList :: [StickCalibration] -> ShowS
show :: StickCalibration -> String
$cshow :: StickCalibration -> String
showsPrec :: Int -> StickCalibration -> ShowS
$cshowsPrec :: Int -> StickCalibration -> ShowS
Show)
class HasCalibration (t :: ControllerType) where
calibrate :: RawCalibration -> Calibration
instance HasCalibration 'LeftJoyCon where
calibrate :: RawCalibration -> Calibration
calibrate (RawCalibration RawStickCalibration
l RawStickCalibration
r RawSensorCalibration
s) =
Calibration :: (Float, Float, Float)
-> (Float, Float, Float)
-> StickCalibration
-> StickCalibration
-> Calibration
Calibration
{ accCoeffs :: (Float, Float, Float)
accCoeffs = (Int16 -> Int16 -> Float)
-> (Int16, Int16, Int16)
-> (Int16, Int16, Int16)
-> (Float, Float, Float)
forall a b c. (a -> b -> c) -> (a, a, a) -> (b, b, b) -> (c, c, c)
tripleZipWith Int16 -> Int16 -> Float
toAccCoeff (RawSensorCalibration -> (Int16, Int16, Int16)
rawAcc RawSensorCalibration
s) (RawSensorCalibration -> (Int16, Int16, Int16)
rawAccSensitivity RawSensorCalibration
s)
, gyroCoeffs :: (Float, Float, Float)
gyroCoeffs = (Int16 -> Int16 -> Float)
-> (Int16, Int16, Int16)
-> (Int16, Int16, Int16)
-> (Float, Float, Float)
forall a b c. (a -> b -> c) -> (a, a, a) -> (b, b, b) -> (c, c, c)
tripleZipWith Int16 -> Int16 -> Float
toGyroCoeff (RawSensorCalibration -> (Int16, Int16, Int16)
rawGyro RawSensorCalibration
s) (RawSensorCalibration -> (Int16, Int16, Int16)
rawGyroSensitivity RawSensorCalibration
s)
, leftStickCal :: StickCalibration
leftStickCal = Float -> Float -> RawStickCalibration -> StickCalibration
toStickCal Float
0.15 Float
0.10 RawStickCalibration
l
, rightStickCal :: StickCalibration
rightStickCal = Float -> Float -> RawStickCalibration -> StickCalibration
toStickCal Float
0.15 Float
0.10 RawStickCalibration
r
}
instance HasCalibration 'RightJoyCon where
calibrate :: RawCalibration -> Calibration
calibrate (RawCalibration RawStickCalibration
l RawStickCalibration
r RawSensorCalibration
s) =
Calibration :: (Float, Float, Float)
-> (Float, Float, Float)
-> StickCalibration
-> StickCalibration
-> Calibration
Calibration
{ accCoeffs :: (Float, Float, Float)
accCoeffs = (Int16 -> Int16 -> Float)
-> (Int16, Int16, Int16)
-> (Int16, Int16, Int16)
-> (Float, Float, Float)
forall a b c. (a -> b -> c) -> (a, a, a) -> (b, b, b) -> (c, c, c)
tripleZipWith Int16 -> Int16 -> Float
toAccCoeff (RawSensorCalibration -> (Int16, Int16, Int16)
rawAcc RawSensorCalibration
s) (RawSensorCalibration -> (Int16, Int16, Int16)
rawAccSensitivity RawSensorCalibration
s)
, gyroCoeffs :: (Float, Float, Float)
gyroCoeffs = (Int16 -> Int16 -> Float)
-> (Int16, Int16, Int16)
-> (Int16, Int16, Int16)
-> (Float, Float, Float)
forall a b c. (a -> b -> c) -> (a, a, a) -> (b, b, b) -> (c, c, c)
tripleZipWith Int16 -> Int16 -> Float
toGyroCoeff (RawSensorCalibration -> (Int16, Int16, Int16)
rawGyro RawSensorCalibration
s) (RawSensorCalibration -> (Int16, Int16, Int16)
rawGyroSensitivity RawSensorCalibration
s)
, leftStickCal :: StickCalibration
leftStickCal = Float -> Float -> RawStickCalibration -> StickCalibration
toStickCal Float
0.15 Float
0.10 RawStickCalibration
l
, rightStickCal :: StickCalibration
rightStickCal = Float -> Float -> RawStickCalibration -> StickCalibration
toStickCal Float
0.15 Float
0.10 RawStickCalibration
r
}
instance HasCalibration 'ProController where
calibrate :: RawCalibration -> Calibration
calibrate (RawCalibration RawStickCalibration
l RawStickCalibration
r RawSensorCalibration
s) =
Calibration :: (Float, Float, Float)
-> (Float, Float, Float)
-> StickCalibration
-> StickCalibration
-> Calibration
Calibration
{ accCoeffs :: (Float, Float, Float)
accCoeffs = (Int16 -> Int16 -> Float)
-> (Int16, Int16, Int16)
-> (Int16, Int16, Int16)
-> (Float, Float, Float)
forall a b c. (a -> b -> c) -> (a, a, a) -> (b, b, b) -> (c, c, c)
tripleZipWith Int16 -> Int16 -> Float
toAccCoeff (RawSensorCalibration -> (Int16, Int16, Int16)
rawAcc RawSensorCalibration
s) (RawSensorCalibration -> (Int16, Int16, Int16)
rawAccSensitivity RawSensorCalibration
s)
, gyroCoeffs :: (Float, Float, Float)
gyroCoeffs = (Int16 -> Int16 -> Float)
-> (Int16, Int16, Int16)
-> (Int16, Int16, Int16)
-> (Float, Float, Float)
forall a b c. (a -> b -> c) -> (a, a, a) -> (b, b, b) -> (c, c, c)
tripleZipWith Int16 -> Int16 -> Float
toGyroCoeff (RawSensorCalibration -> (Int16, Int16, Int16)
rawGyro RawSensorCalibration
s) (RawSensorCalibration -> (Int16, Int16, Int16)
rawGyroSensitivity RawSensorCalibration
s)
, leftStickCal :: StickCalibration
leftStickCal = Float -> Float -> RawStickCalibration -> StickCalibration
toStickCal Float
0.10 Float
0.10 RawStickCalibration
l
, rightStickCal :: StickCalibration
rightStickCal = Float -> Float -> RawStickCalibration -> StickCalibration
toStickCal Float
0.10 Float
0.10 RawStickCalibration
r
}
toAccCoeff :: Int16 -> Int16 -> Float
toAccCoeff :: Int16 -> Int16 -> Float
toAccCoeff Int16
sense Int16
value =
(Float
1 Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ (Int16 -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int16
sense Float -> Float -> Float
forall a. Num a => a -> a -> a
- Int16 -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int16
value)) Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
4
toGyroCoeff :: Int16 -> Int16 -> Float
toGyroCoeff :: Int16 -> Int16 -> Float
toGyroCoeff Int16
sense Int16
value =
(Float
936 Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ (Int16 -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int16
sense Float -> Float -> Float
forall a. Num a => a -> a -> a
- Int16 -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int16
value)) Float -> Float -> Float
forall a. Num a => a -> a -> a
* (Float
forall a. Floating a => a
pi Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
180)
toStickCal :: Float -> Float -> RawStickCalibration -> StickCalibration
toStickCal :: Float -> Float -> RawStickCalibration -> StickCalibration
toStickCal Float
dc Float
dout RawStickCalibration
raw =
StickCalibration :: Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> StickCalibration
StickCalibration
{ deadCenter :: Float
deadCenter = Float
dc
, deadOuter :: Float
deadOuter = Float
dout
, minusX :: Float
minusX = Word16 -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Float) -> Word16 -> Float
forall a b. (a -> b) -> a -> b
$ RawStickCalibration -> Word16
rawMinusX RawStickCalibration
raw
, centerX :: Float
centerX = Word16 -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Float) -> Word16 -> Float
forall a b. (a -> b) -> a -> b
$ RawStickCalibration -> Word16
rawCenterX RawStickCalibration
raw
, plusX :: Float
plusX = Word16 -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Float) -> Word16 -> Float
forall a b. (a -> b) -> a -> b
$ RawStickCalibration -> Word16
rawPlusX RawStickCalibration
raw
, minusY :: Float
minusY = Word16 -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Float) -> Word16 -> Float
forall a b. (a -> b) -> a -> b
$ RawStickCalibration -> Word16
rawMinusY RawStickCalibration
raw
, centerY :: Float
centerY = Word16 -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Float) -> Word16 -> Float
forall a b. (a -> b) -> a -> b
$ RawStickCalibration -> Word16
rawCenterY RawStickCalibration
raw
, plusY :: Float
plusY = Word16 -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Float) -> Word16 -> Float
forall a b. (a -> b) -> a -> b
$ RawStickCalibration -> Word16
rawPlusY RawStickCalibration
raw
}
axisCalibrationParser :: Parser RawSensorCalibration
axisCalibrationParser :: Parser RawSensorCalibration
axisCalibrationParser = do
(Int16, Int16, Int16)
acc <- Parser (Int16, Int16, Int16)
forall a. (Bits a, Num a) => Parser (a, a, a)
tripleParser
(Int16, Int16, Int16)
accSense <- Parser (Int16, Int16, Int16)
forall a. (Bits a, Num a) => Parser (a, a, a)
tripleParser
(Int16, Int16, Int16)
gyro <- Parser (Int16, Int16, Int16)
forall a. (Bits a, Num a) => Parser (a, a, a)
tripleParser
(Int16, Int16, Int16)
gyroSense <- Parser (Int16, Int16, Int16)
forall a. (Bits a, Num a) => Parser (a, a, a)
tripleParser
RawSensorCalibration -> Parser RawSensorCalibration
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RawSensorCalibration -> Parser RawSensorCalibration)
-> RawSensorCalibration -> Parser RawSensorCalibration
forall a b. (a -> b) -> a -> b
$
RawSensorCalibration :: (Int16, Int16, Int16)
-> (Int16, Int16, Int16)
-> (Int16, Int16, Int16)
-> (Int16, Int16, Int16)
-> RawSensorCalibration
RawSensorCalibration
{ rawAcc :: (Int16, Int16, Int16)
rawAcc = (Int16, Int16, Int16)
acc
, rawAccSensitivity :: (Int16, Int16, Int16)
rawAccSensitivity = (Int16, Int16, Int16)
accSense
, rawGyro :: (Int16, Int16, Int16)
rawGyro = (Int16, Int16, Int16)
gyro
, rawGyroSensitivity :: (Int16, Int16, Int16)
rawGyroSensitivity = (Int16, Int16, Int16)
gyroSense
}
axisUserParser :: Parser RawSensorCalibration
axisUserParser :: Parser RawSensorCalibration
axisUserParser = do
Word8
_ <- Word8 -> Parser Word8
word8 Word8
0xB2
Word8
_ <- Word8 -> Parser Word8
word8 Word8
0xA1
Parser RawSensorCalibration
axisCalibrationParser
parseStickUserCalibration :: ByteString -> (Maybe RawStickCalibration, Maybe RawStickCalibration)
parseStickUserCalibration :: ByteString
-> (Maybe RawStickCalibration, Maybe RawStickCalibration)
parseStickUserCalibration ByteString
string =
case Parser (Maybe RawStickCalibration, Maybe RawStickCalibration)
-> ByteString
-> Result (Maybe RawStickCalibration, Maybe RawStickCalibration)
forall a. Parser a -> ByteString -> Result a
parse Parser (Maybe RawStickCalibration, Maybe RawStickCalibration)
stickUserParser ByteString
string of
Done ByteString
_ (Maybe RawStickCalibration, Maybe RawStickCalibration)
result -> (Maybe RawStickCalibration, Maybe RawStickCalibration)
result
Result (Maybe RawStickCalibration, Maybe RawStickCalibration)
_ -> (Maybe RawStickCalibration
forall a. Maybe a
Nothing, Maybe RawStickCalibration
forall a. Maybe a
Nothing)
stickCalibrationParser :: (Bits a, Num a) => Parser (a, a, a, a, a, a)
stickCalibrationParser :: Parser (a, a, a, a, a, a)
stickCalibrationParser = do
a
byte0 <- Word8 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> a) -> Parser Word8 -> Parser ByteString a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Word8
anyWord8
a
byte1 <- Word8 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> a) -> Parser Word8 -> Parser ByteString a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Word8
anyWord8
a
byte2 <- Word8 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> a) -> Parser Word8 -> Parser ByteString a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Word8
anyWord8
a
byte3 <- Word8 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> a) -> Parser Word8 -> Parser ByteString a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Word8
anyWord8
a
byte4 <- Word8 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> a) -> Parser Word8 -> Parser ByteString a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Word8
anyWord8
a
byte5 <- Word8 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> a) -> Parser Word8 -> Parser ByteString a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Word8
anyWord8
a
byte6 <- Word8 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> a) -> Parser Word8 -> Parser ByteString a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Word8
anyWord8
a
byte7 <- Word8 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> a) -> Parser Word8 -> Parser ByteString a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Word8
anyWord8
a
byte8 <- Word8 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> a) -> Parser Word8 -> Parser ByteString a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Word8
anyWord8
let d0 :: a
d0 = a -> Int -> a
forall a. Bits a => a -> Int -> a
shiftL a
byte1 Int
8 a -> a -> a
forall a. Bits a => a -> a -> a
.&. a
0x0F00 a -> a -> a
forall a. Bits a => a -> a -> a
.|. a
byte0
d1 :: a
d1 = a -> Int -> a
forall a. Bits a => a -> Int -> a
shiftL a
byte2 Int
4 a -> a -> a
forall a. Bits a => a -> a -> a
.|. a -> Int -> a
forall a. Bits a => a -> Int -> a
shiftR a
byte1 Int
4
d2 :: a
d2 = a -> Int -> a
forall a. Bits a => a -> Int -> a
shiftL a
byte4 Int
8 a -> a -> a
forall a. Bits a => a -> a -> a
.&. a
0x0F00 a -> a -> a
forall a. Bits a => a -> a -> a
.|. a
byte3
d3 :: a
d3 = a -> Int -> a
forall a. Bits a => a -> Int -> a
shiftL a
byte5 Int
4 a -> a -> a
forall a. Bits a => a -> a -> a
.|. a -> Int -> a
forall a. Bits a => a -> Int -> a
shiftR a
byte4 Int
4
d4 :: a
d4 = a -> Int -> a
forall a. Bits a => a -> Int -> a
shiftL a
byte7 Int
8 a -> a -> a
forall a. Bits a => a -> a -> a
.&. a
0x0F00 a -> a -> a
forall a. Bits a => a -> a -> a
.|. a
byte6
d5 :: a
d5 = a -> Int -> a
forall a. Bits a => a -> Int -> a
shiftL a
byte8 Int
4 a -> a -> a
forall a. Bits a => a -> a -> a
.|. a -> Int -> a
forall a. Bits a => a -> Int -> a
shiftR a
byte7 Int
4
(a, a, a, a, a, a) -> Parser (a, a, a, a, a, a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
d0, a
d1, a
d2, a
d3, a
d4, a
d5)
leftStickCalibrationParser :: Parser RawStickCalibration
leftStickCalibrationParser :: Parser RawStickCalibration
leftStickCalibrationParser = do
(Word16
d0, Word16
d1, Word16
d2, Word16
d3, Word16
d4, Word16
d5) <- Parser (Word16, Word16, Word16, Word16, Word16, Word16)
forall a. (Bits a, Num a) => Parser (a, a, a, a, a, a)
stickCalibrationParser
RawStickCalibration -> Parser RawStickCalibration
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RawStickCalibration -> Parser RawStickCalibration)
-> RawStickCalibration -> Parser RawStickCalibration
forall a b. (a -> b) -> a -> b
$
RawStickCalibration :: Word16
-> Word16
-> Word16
-> Word16
-> Word16
-> Word16
-> RawStickCalibration
RawStickCalibration
{ rawMinusX :: Word16
rawMinusX = Word16
d2 Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
- Word16
d4
, rawCenterX :: Word16
rawCenterX = Word16
d2
, rawPlusX :: Word16
rawPlusX = Word16
d2 Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
+ Word16
d0
, rawMinusY :: Word16
rawMinusY = Word16
d3 Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
- Word16
d5
, rawCenterY :: Word16
rawCenterY = Word16
d3
, rawPlusY :: Word16
rawPlusY = Word16
d3 Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
+ Word16
d1
}
rightStickCalibrationParser :: Parser RawStickCalibration
rightStickCalibrationParser :: Parser RawStickCalibration
rightStickCalibrationParser = do
(Word16
d0, Word16
d1, Word16
d2, Word16
d3, Word16
d4, Word16
d5) <- Parser (Word16, Word16, Word16, Word16, Word16, Word16)
forall a. (Bits a, Num a) => Parser (a, a, a, a, a, a)
stickCalibrationParser
RawStickCalibration -> Parser RawStickCalibration
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RawStickCalibration -> Parser RawStickCalibration)
-> RawStickCalibration -> Parser RawStickCalibration
forall a b. (a -> b) -> a -> b
$
RawStickCalibration :: Word16
-> Word16
-> Word16
-> Word16
-> Word16
-> Word16
-> RawStickCalibration
RawStickCalibration
{ rawMinusX :: Word16
rawMinusX = Word16
d0 Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
- Word16
d2
, rawCenterX :: Word16
rawCenterX = Word16
d0
, rawPlusX :: Word16
rawPlusX = Word16
d0 Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
+ Word16
d4
, rawMinusY :: Word16
rawMinusY = Word16
d1 Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
- Word16
d3
, rawCenterY :: Word16
rawCenterY = Word16
d1
, rawPlusY :: Word16
rawPlusY = Word16
d1 Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
+ Word16
d5
}
stickFactoryParser :: Parser (RawStickCalibration, RawStickCalibration)
stickFactoryParser :: Parser (RawStickCalibration, RawStickCalibration)
stickFactoryParser = do
RawStickCalibration
leftCal <- Parser RawStickCalibration
leftStickCalibrationParser
RawStickCalibration
rightCal <- Parser RawStickCalibration
rightStickCalibrationParser
(RawStickCalibration, RawStickCalibration)
-> Parser (RawStickCalibration, RawStickCalibration)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RawStickCalibration
leftCal, RawStickCalibration
rightCal)
stickUserParser :: Parser (Maybe RawStickCalibration, Maybe RawStickCalibration)
stickUserParser :: Parser (Maybe RawStickCalibration, Maybe RawStickCalibration)
stickUserParser = do
Word8
magicL0 <- Parser Word8
anyWord8
Word8
magicL1 <- Parser Word8
anyWord8
Maybe RawStickCalibration
ls <- if Word8
magicL0 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0xB2 Bool -> Bool -> Bool
&& Word8
magicL1 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0xA1
then RawStickCalibration -> Maybe RawStickCalibration
forall a. a -> Maybe a
Just (RawStickCalibration -> Maybe RawStickCalibration)
-> Parser RawStickCalibration
-> Parser ByteString (Maybe RawStickCalibration)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser RawStickCalibration
leftStickCalibrationParser
else Maybe RawStickCalibration
-> ByteString -> Maybe RawStickCalibration
forall a b. a -> b -> a
const Maybe RawStickCalibration
forall a. Maybe a
Nothing (ByteString -> Maybe RawStickCalibration)
-> Parser ByteString ByteString
-> Parser ByteString (Maybe RawStickCalibration)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Parser ByteString ByteString
take Int
9
Word8
magicR0 <- Parser Word8
anyWord8
Word8
magicR1 <- Parser Word8
anyWord8
Maybe RawStickCalibration
rs <- if Word8
magicR0 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0xB2 Bool -> Bool -> Bool
&& Word8
magicR1 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0xA1
then RawStickCalibration -> Maybe RawStickCalibration
forall a. a -> Maybe a
Just (RawStickCalibration -> Maybe RawStickCalibration)
-> Parser RawStickCalibration
-> Parser ByteString (Maybe RawStickCalibration)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser RawStickCalibration
rightStickCalibrationParser
else Maybe RawStickCalibration
-> Parser ByteString (Maybe RawStickCalibration)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe RawStickCalibration
forall a. Maybe a
Nothing
(Maybe RawStickCalibration, Maybe RawStickCalibration)
-> Parser (Maybe RawStickCalibration, Maybe RawStickCalibration)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe RawStickCalibration
ls, Maybe RawStickCalibration
rs)