{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds           #-}
{-# LANGUAGE KindSignatures      #-}
module Device.Nintendo.Switch.Controller where

-- attoparsec

import Data.Attoparsec.ByteString (IResult(Done), Parser, anyWord8, parse, take, word8)

-- base

import Data.Bits      ((.&.), (.|.), Bits, shiftL, shiftR)
import Data.Int       (Int16)
import Data.IORef     (IORef)
import Data.Word      (Word8, Word16)
import Prelude hiding (take)

-- bytestring

import Data.ByteString (ByteString)

-- hidapi

import System.HIDAPI (Device)

-- switch

import Device.Nintendo.Switch.Utils (tripleParser, tripleZipWith)

-- | The types of Nintendo Switch controllers that are currently supported by

-- this library.

--

-- Note that this type is mostly used on the type level (using @DataKinds@)

-- in order to prevent programming mistakes at compile-time (e.g., to prevent

-- sending a rumble command to a controller which has no rumble feature).

--

-- Chances are very high that you don't need this type on the value level, but

-- rather on the type level, for example via @TypeApplications@

-- (see 'Device.Nintendo.Switch.getControllerInfos').

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)

-- | A handle which represents a connected Nintendo Switch controller.

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)

-- | A constraint which indicates that a Nintendo Switch controller is able to

-- turn portions of its internal flash memory into valid calibration information.

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 -- in Gs


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) -- in radians per second


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)