module Network.UI.Kafka.Interpretation (
Interpretation(..)
, AxisInterpretation(..)
, AnalogHandler
, ButtonHandler
, interpretationLoop
) where
import Control.Concurrent.MVar (MVar, newMVar, readMVar, swapMVar)
import Control.Monad (unless, void)
import Data.Aeson.Types (FromJSON, ToJSON)
import GHC.Generics (Generic)
import Linear.Conjugate (Conjugate)
import Linear.Epsilon (Epsilon)
import Linear.Quaternion (Quaternion(..), axisAngle, rotate)
import Linear.V3 (V3(..))
import Linear.Vector ((^+^), basis)
import Network.UI.Kafka (ExitAction, LoopAction, Sensor, TopicConnection, producerLoop)
import Network.UI.Kafka.Types (Button(..), Event(ButtonEvent, LocationEvent, OrientationEvent), Toggle(..))
instance FromJSON a => FromJSON (V3 a)
instance ToJSON a => ToJSON (V3 a)
instance FromJSON a => FromJSON (Quaternion a)
instance ToJSON a => ToJSON (Quaternion a)
data Interpretation a =
TrackInterpretation
{
kafka :: TopicConnection
, sensor :: Sensor
, path :: FilePath
, xAxis :: AxisInterpretation a
, yAxis :: AxisInterpretation a
, zAxis :: AxisInterpretation a
, phiAxis :: AxisInterpretation a
, thetaAxis :: AxisInterpretation a
, psiAxis :: AxisInterpretation a
, location :: V3 a
, orientation :: V3 a
, flying :: Bool
, resetButton :: Maybe Int
}
deriving (Eq, Generic, Read, Show)
instance FromJSON a => FromJSON (Interpretation a)
instance ToJSON a => ToJSON (Interpretation a)
data AxisInterpretation a =
AxisInterpretation
{
axisNumber :: Int
, threshold :: Maybe a
, increment :: a
, lowerBound :: Maybe a
, upperBound :: Maybe a
}
deriving (Eq, Generic, Read, Show)
instance FromJSON a => FromJSON (AxisInterpretation a)
instance ToJSON a => ToJSON (AxisInterpretation a)
translate :: (Conjugate a, Epsilon a, Num a, Ord a, RealFloat a)
=> MVar (State a)
-> AnalogHandler a b
-> ButtonHandler a b
-> Interpretation a
-> b
-> IO [Event]
translate state analogHandler buttonHandler TrackInterpretation{..} event =
do
(location0, orientation0) <- readMVar state
let
adjust number setting AxisInterpretation{..} =
if number == axisNumber && maybe True (abs setting >) threshold
then setting * increment
else 0
clamp AxisInterpretation{..} =
maybe id ((maximum .) . (. return) . (:)) lowerBound
. maybe id ((minimum .) . (. return) . (:)) upperBound
(location1@(V3 x y z), orientation1@(Quaternion q0 (V3 qx qy qz))) =
case (buttonHandler event, analogHandler event) of
(Just (number, pressed), _) -> if pressed && Just number == resetButton
then (location, eulerToQuaternion orientation)
else (location0, orientation0)
(_, Just (number, setting)) -> let
euler = adjust number setting <$> V3 phiAxis thetaAxis psiAxis
axes = V3 xAxis yAxis zAxis
delta = adjust number setting <$> axes
in
(
clamp
<$> axes
<*> location0
^+^ (if flying then (orientation0 `rotate`) else id) delta
, eulerToQuaternion euler
* orientation0
)
(_, _) -> (location0, orientation0)
[x', y', z', q0', qx', qy', qz'] = realToFrac <$> [x, y, z, q0, qx, qy, qz]
unless (location0 == location1 && orientation0 == orientation1)
. void
$ swapMVar state (location1, orientation1)
return
. (if location0 /= location1 then (LocationEvent ( x' , y' , z' ) :) else id)
. (if orientation0 /= orientation1 then (OrientationEvent (q0', qx', qy', qz') :) else id)
$ case buttonHandler event of
Just (number, pressed) -> [ButtonEvent (IndexButton number, if pressed then Down else Up)]
Nothing -> []
eulerToQuaternion :: (Epsilon a, Num a, RealFloat a) => V3 a -> Quaternion a
eulerToQuaternion (V3 phi theta psi) =
let
[ex, ey, ez] = basis
in
ez `axisAngle` psi * ey `axisAngle` theta * ex `axisAngle` phi
type State a = (V3 a, Quaternion a)
type AnalogHandler a b = b -> Maybe (Int, a)
type ButtonHandler a b = b -> Maybe (Int, Bool)
interpretationLoop :: (Conjugate a, Epsilon a, Num a, Ord a, RealFloat a)
=> AnalogHandler a b
-> ButtonHandler a b
-> Interpretation a
-> IO b
-> IO (ExitAction, LoopAction)
interpretationLoop analogHandler buttonHandler interpretation@TrackInterpretation{..} action =
do
state <- newMVar (location, eulerToQuaternion orientation)
producerLoop kafka sensor
$ translate state analogHandler buttonHandler interpretation
=<< action