hleap (empty) → 0.1.2.4
raw patch · 11 files changed
+874/−0 lines, 11 filesdep +aesondep +basedep +containerssetup-changed
Dependencies added: aeson, base, containers, data-default, mtl, text, unordered-containers, websockets
Files
- LICENSE +20/−0
- ReadMe.md +16/−0
- Setup.hs +2/−0
- hleap.cabal +60/−0
- src/Main.hs +57/−0
- src/System/Hardware/Leap.hs +165/−0
- src/System/Hardware/Leap/Event.hs +143/−0
- src/System/Hardware/Leap/Event/Gesture.hs +141/−0
- src/System/Hardware/Leap/Event/Hand.hs +93/−0
- src/System/Hardware/Leap/Event/Pointable.hs +136/−0
- src/System/Hardware/Leap/Types.hs +41/−0
+ LICENSE view
@@ -0,0 +1,20 @@+Copyright (c) 2016 Brian W Bush++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ ReadMe.md view
@@ -0,0 +1,16 @@+Web Socket interface for Leap Motion controllers+================================================++This Haskell package contains functions for interfacing with Leap Motion controllers, <<https://www.leapmotion.com/product/desktop>>. It is based on the WebSocket API <<https://developer.leapmotion.com/documentation/javascript/supplements/Leap_JSON.html>> and inspired by <<https://bitbucket.org/turion/jedinight/>>. It has been tested with Service Version 2.3.1+31549 of the Web Sockets server from Leap Motion.++Skeletal example+----------------++This simple example program prints all Leap Motion events:++```haskell+main :: IO ()+main =+ runWithHandler def [setFocused True, setGestures True] $ \event ->+ print (event :: Event Float)+```
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ hleap.cabal view
@@ -0,0 +1,60 @@+name: hleap+version: 0.1.2.4+synopsis: Web Socket interface to Leap Motion controller+description: This Haskell package contains functions for interfacing with Leap Motion controllers, <<https://www.leapmotion.com/product/desktop>>. It is based on the WebSocket API <<https://developer.leapmotion.com/documentation/javascript/supplements/Leap_JSON.html>> and inspired by <<https://bitbucket.org/turion/jedinight/>>. It has been tested with Service Version 2.3.1+31549 of the Web Sockets server from Leap Motion.++license: MIT+license-file: LICENSE+author: Brian W Bush <consult@brianwbush.info>+maintainer: Brian W Bush <consult@brianwbush.info>+copyright: (c) 2016 Brian W Bush+category: Hardware+build-type: Simple+cabal-version: >= 1.10+stability: Stable+homepage: https://bitbucket.org/bwbush/hleap+bug-reports: https://bwbush.atlassian.net/projects/HLEAP/issues/+package-url: https://bitbucket.org/bwbush/hleap/downloads/hleap-0.1.2.4.tar.gz+author: Brian W Bush+maintainer: b.w.bush@acm.org++extra-source-files: ReadMe.md++source-repository head+ type: git+ location: https://bwbush@bitbucket.org/bwbush/hleap.git+ +library+ build-depends: base >= 4.8 && < 5+ , aeson >= 0.10.0.0+ , containers >= 0.5.6.2+ , data-default >= 0.5.3+ , mtl >= 2.2.1+ , text >= 1.2.1.3+ , unordered-containers >= 0.2.5.1+ , websockets >= 0.9.6.1+ exposed-modules: System.Hardware.Leap+ System.Hardware.Leap.Event+ System.Hardware.Leap.Event.Gesture+ System.Hardware.Leap.Event.Hand+ System.Hardware.Leap.Event.Pointable+ System.Hardware.Leap.Types+ hs-source-dirs: src+ exposed: True+ buildable: True+ ghc-options: -Wall+ default-language: Haskell2010++executable leap-tracker+ main-is: Main.hs+ build-depends: base >=4.8 && <4.9+ , aeson+ , containers+ , data-default+ , mtl+ , text+ , unordered-containers+ , websockets+ hs-source-dirs: src+ ghc-options: -Wall+ default-language: Haskell2010
+ src/Main.hs view
@@ -0,0 +1,57 @@+{-|+Module : Main+Copyright : (c) 2016 Brian W Bush+License : MIT+Maintainer : Brian W Bush <consult@brianwbush.info>+Stability : Stable+Portability : Portable+++Tracing events from Leap Motion \<<https://www.leapmotion.com/product/desktop>\>, based on the Web Socket API \<<https://developer.leapmotion.com/documentation/javascript/supplements/Leap_JSON.html>\>.+-}+++{-# LANGUAGE RecordWildCards #-}+++module Main (+ main+) where+++import Data.Default (def)+import System.Hardware.Leap (runWithHandler, setFocused, setGestures)+import System.Hardware.Leap.Event (Event(..))+import System.Hardware.Leap.Event.Hand (Hand(side))+import System.Hardware.Leap.Event.Gesture (Gesture(..))+import System.Hardware.Leap.Event.Pointable (Pointable(..))+++-- | Main entry point.+main :: IO ()+main = runWithHandler def [setFocused True, setGestures True] handler+++-- | Handle events.+handler :: Event Float -> IO ()+handler Tracking{..}+ | not (null gestures ) = mapM_ handleGesture gestures+ | not (null pointables) = mapM_ handlePointable pointables+ | otherwise = return ()+handler _ = return ()+++-- | Handle pointable events.+handlePointable :: Show a => Pointable a -> IO ()+handlePointable Finger{..} = putStrLn $ "FINGER\t " ++ show (side hand) ++ "\t" ++ show finger ++ "\t" ++ show stabilizedTipPosition+handlePointable Tool{..} = putStrLn $ "TOOL\t " ++ show (side hand) ++ "\t" ++ show stabilizedTipPosition+handlePointable PointableReference{} = return ()+++-- | Handle gesture events.+handleGesture :: Gesture a -> IO ()+handleGesture Circle{..} = putStrLn $ "CIRCLE\t " ++ show state ++ "\t" ++ show (map side hands)+handleGesture Swipe{..} = putStrLn $ "SWIPE\t" ++ show state ++ "\t" ++ show (map side hands)+handleGesture KeyTap{..} = putStrLn $ "KEY TAP\t" ++ show state ++ "\t" ++ show (map side hands)+handleGesture ScreenTap{..} = putStrLn $ "SCREEN TAP\t" ++ show state ++ "\t" ++ show (map side hands)+handleGesture GestureReference{} = return ()
+ src/System/Hardware/Leap.hs view
@@ -0,0 +1,165 @@+{-|+Module : System.Hardware.Leap+Copyright : (c) 2016 Brian W Bush+License : MIT+Maintainer : Brian W Bush <consult@brianwbush.info>+Stability : Stable+Portability : Portable+++Interaction with Leap Motion \<<https://www.leapmotion.com/product/desktop>\>, based on the Web Socket API \<<https://developer.leapmotion.com/documentation/javascript/supplements/Leap_JSON.html>\>.++Here is a simple example applicaton that prints all events:++@+main :: IO ()+main =+ runWithHandler def [setFocused True, setGestures True] $ \event ->+ print (event :: Event Float)+@+-}+++{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+++module System.Hardware.Leap (+-- * Configuration+ Configuration(..)+, Version(..)+, setBackground+, setFocused+, setGestures+, setOptimizedHMD+-- * Applications+, ClientApp+, Handler+, run+, runWithHandler+) where+++import Control.Applicative (empty)+import Control.Monad (forever)+import Data.Aeson (FromJSON(..), Value(..), (.:), eitherDecode)+import Data.Default (Default(..))+import Data.Text (pack)+import Network.WebSockets (Connection, receiveData, runClient, sendTextData)+import System.Hardware.Leap.Event (Event(..))+++-- | Configuration for a connection to a Leap Motion controller via Web Sockets.+data Configuration =+ Configuration+ {+ host :: String -- ^ Host name.+ , port :: Int -- ^ Port number.+ }+ deriving (Eq, Ord, Read, Show)++instance Default Configuration where+ def =+ Configuration+ {+ host = "localhost"+ , port = 6437+ }+++-- | A client application for Leap Motion using Web Sockets.+type ClientApp a = Connection -- ^ The Web Socet connection.+ -> IO a -- ^ Action for the client application.+++-- | A handler for Leap Motion events.+type Handler a = Event a -- ^ The event.+ -> IO () -- ^ The action for handling the event.+++-- | Run a Leap Motion application using Web Sockets.+run :: Configuration -- ^ The Web Socket configuration.+ -> ClientApp a -- ^ The client application.+ -> IO a -- ^ Action for running the client.+run Configuration{..} app =+ runClient host port "/v6.json" $ \connection ->+ do+ version' <- eitherDecode <$> receiveData connection+ case version' of+ Right v@(Version _ 6) -> putStrLn $ "Leap connection" ++ show v+ Right v -> error $ "Incorrect version: " ++ show v+ Left s -> error s+ app connection+++-- | Modify a Leap Motion connection.+type ConnectionModifier = Connection -- ^ The Web Socket connection.+ -> IO () -- ^ Action for modifying the connection.+++-- | Run and process events from Leap Motion using Web Sockets.+runWithHandler :: FromJSON a+ => Configuration -- ^ The Web Socket configuration.+ -> [ConnectionModifier] -- ^ Modifications to be made to the connection.+ -> Handler a -- ^ The event handler.+ -> IO () -- ^ Action for running with event handling.+runWithHandler configuration modifiers handler =+ run configuration $ \connection ->+ do+ mapM_ ($ connection) modifiers+ forever $ do+ event' <- eitherDecode <$> receiveData connection+ case event' of+ Right e -> handler e+ Left s -> error s+++-- | Version information for Leap Motion.+data Version =+ Version+ {+ serviceVersion :: String+ , version :: Int+ }+ deriving (Eq, Ord, Read, Show)++instance FromJSON Version where+ parseJSON (Object o) =+ Version+ <$> o .: "serviceVersion"+ <*> o .: "version"+ parseJSON _ = empty+++-- | Enable or disable background events. See \<<https://developer.leapmotion.com/documentation/javascript/supplements/Leap_JSON.html>\> for details.+setBackground :: Bool -- ^ Whether to enable background events.+ -> ConnectionModifier -- ^ Function for making the modification.+setBackground = setSomething "background"+++-- | Enable or disable focus. See \<<https://developer.leapmotion.com/documentation/javascript/supplements/Leap_JSON.html>\> for details.+setFocused :: Bool -- ^ Whether to enable focus.+ -> ConnectionModifier -- ^ Function for making the modification.+setFocused = setSomething "focused"+++-- | Enable or disable gestures. See \<<https://developer.leapmotion.com/documentation/javascript/supplements/Leap_JSON.html>\> for details.+setGestures :: Bool -- ^ Whether to enable gestiure events.+ -> ConnectionModifier -- ^ Function for making the modification.+setGestures = setSomething "enableGestures"+++-- | Enable or disable head-mounted-display optimization. See \<<https://developer.leapmotion.com/documentation/javascript/supplements/Leap_JSON.html>\> for details.+setOptimizedHMD :: Bool -- ^ Whether to enable HMD optimization.+ -> ConnectionModifier -- ^ Function for making the modification.+setOptimizedHMD = setSomething "optimizeHMD"+++-- | Enable or disable something in Leap Motion.+setSomething :: String -- ^ What to enable or disable.+ -> Bool -- ^ Whether to enable it.+ -> ConnectionModifier -- ^ Function for making the modification.+setSomething item enabled connection =+ sendTextData connection+ $ pack+ $ "{\"" ++ item ++ "\" : " ++ (if enabled then "true" else "false") ++ "}"
+ src/System/Hardware/Leap/Event.hs view
@@ -0,0 +1,143 @@+{-|+Module : System.Hardware.Leap.Event+Copyright : (c) 2016 Brian W Bush+License : MIT+Maintainer : Brian W Bush <consult@brianwbush.info>+Stability : Stable+Portability : Portable+++Events for Leap Motion \<<https://www.leapmotion.com/product/desktop>\>, based on the Web Socket API \<<https://developer.leapmotion.com/documentation/javascript/supplements/Leap_JSON.html>\>.+-}+++{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+++module System.Hardware.Leap.Event (+-- * Events+ Event(..)+, State(..)+, InteractionBox(..)+) where+++import Control.Applicative (empty)+import Data.Aeson (FromJSON(..), Value(..), (.:))+import Data.List (find)+import Data.Maybe (fromMaybe)+import System.Hardware.Leap.Event.Gesture (Gesture(..))+import System.Hardware.Leap.Event.Hand (Hand(HandReference))+import System.Hardware.Leap.Event.Pointable (Pointable(..))+import System.Hardware.Leap.Types (Duration, LeapId, Matrix, Vector)++import qualified Data.HashMap.Strict as M (lookup)+import qualified System.Hardware.Leap.Event.Gesture as G (hands, pointables)+import qualified System.Hardware.Leap.Event.Hand as H (leapId)+import qualified System.Hardware.Leap.Event.Pointable as P (hand, leapId)+++-- | State of a Leap device.+data State =+ State+ {+ attached :: Bool+ , leap :: String+ , streaming :: Bool+ , leapType :: String+ }+ deriving (Eq, Ord, Read, Show)++instance FromJSON State where+ parseJSON (Object o) =+ State+ <$> o .: "attached"+ <*> o .: "id"+ <*> o .: "streaming"+ <*> o .: "type"+ parseJSON _ = empty+++-- | Event information. See \<<https://developer.leapmotion.com/documentation/javascript/supplements/Leap_JSON.html>\> for details.+data Event a =+ Event+ {+ state :: State+ , event :: String+ }+ | Tracking+ {+ currentFrameRate :: a+ , leapId :: LeapId+ , r :: Matrix a+ , s :: a+ , t :: Vector a+ , timestamp :: Duration+ , devices :: [String]+ , gestures :: [Gesture a]+ , hands :: [Hand a]+ , interactionBox :: InteractionBox a+ , pointables :: [Pointable a]+ }+ deriving (Eq, Ord, Read, Show)++instance FromJSON a => FromJSON (Event a) where+ parseJSON (Object o) =+ case "event" `M.lookup` o of+ Just (Object o') -> Event+ <$> o' .: "state"+ <*> o' .: "type"+ Nothing -> tracking+ <$> o .: "currentFrameRate"+ <*> o .: "id"+ <*> o .: "r"+ <*> o .: "s"+ <*> o .: "t"+ <*> o .: "timestamp"+ <*> o .: "devices"+ <*> o .: "gestures"+ <*> o .: "hands"+ <*> o .: "interactionBox"+ <*> o .: "pointables"+ _ -> empty+ parseJSON _ = empty+++-- | Construct tracking information.+tracking :: a -> Int -> Matrix a -> a -> Vector a -> Int -> [String] -> [Gesture a] -> [Hand a] -> InteractionBox a -> [Pointable a] -> Event a+tracking currentFrameRate leapId r s t timestamp devices gestures' hands interactionBox pointables' =+ let+ replaceHand h@(HandReference i) = fromMaybe h $ find ((== i) . H.leapId) hands+ replaceHand h = h+ replacePointable p@(PointableReference i) = fromMaybe p $ find ((== i) . P.leapId) pointables+ replacePointable p = p+ updatePointable p@Finger{} = p {P.hand = replaceHand $ P.hand p}+ updatePointable p@Tool{} = p {P.hand = replaceHand $ P.hand p}+ updatePointable p@PointableReference{} = p+ updateGesture g@Circle{} = g {G.hands = map replaceHand $ G.hands g, G.pointables = map replacePointable $ G.pointables g}+ updateGesture g@Swipe{} = g {G.hands = map replaceHand $ G.hands g, G.pointables = map replacePointable $ G.pointables g}+ updateGesture g@KeyTap{} = g {G.hands = map replaceHand $ G.hands g, G.pointables = map replacePointable $ G.pointables g}+ updateGesture g@ScreenTap{} = g {G.hands = map replaceHand $ G.hands g, G.pointables = map replacePointable $ G.pointables g}+ updateGesture g@GestureReference{} = g+ pointables = map updatePointable pointables'+ gestures = map updateGesture gestures'+ in+ Tracking{..}+++-- | An interaction box.+data InteractionBox a =+ InteractionBox+ {+ center :: Vector a+ , size :: Vector a+ }+ deriving (Eq, Ord, Read, Show)++instance FromJSON a => FromJSON (InteractionBox a) where+ parseJSON (Object o) =+ InteractionBox+ <$> o .: "center"+ <*> o .: "size"+ parseJSON _ = empty
+ src/System/Hardware/Leap/Event/Gesture.hs view
@@ -0,0 +1,141 @@+{-|+Module : System.Hardware.Leap.Event.Gesture+Copyright : (c) 2016 Brian W Bush+License : MIT+Maintainer : Brian W Bush <consult@brianwbush.info>+Stability : Stable+Portability : Portable+++Gesture events for Leap Motion \<<https://www.leapmotion.com/product/desktop>\>, based on the Web Socket API \<<https://developer.leapmotion.com/documentation/javascript/supplements/Leap_JSON.html>\>.+-}+++{-# LANGUAGE OverloadedStrings #-}+++module System.Hardware.Leap.Event.Gesture (+-- * Events+ Gesture(..)+, State(..)+) where+++import Control.Applicative (empty)+import Data.Aeson (FromJSON(..), Value(..), (.:))+import System.Hardware.Leap.Event.Hand (Hand(HandReference))+import System.Hardware.Leap.Event.Pointable (Pointable(PointableReference))+import System.Hardware.Leap.Types (Duration, LeapId, Vector)++import qualified Data.HashMap.Strict as M (lookup)+++-- | The state of a gesture.+data State = Start | Update | Stop+ deriving (Bounded, Enum, Eq, Ord, Read, Show)++instance FromJSON State where+ parseJSON (String "start" ) = return Start+ parseJSON (String "update") = return Update+ parseJSON (String "stop" ) = return Stop+ parseJSON _ = empty+++-- | Gesture tracking information. See \<<https://developer.leapmotion.com/documentation/javascript/supplements/Leap_JSON.html>\> for details.+data Gesture a =+ GestureReference+ {+ leapId :: LeapId+ }+ | Circle+ {+ center :: Vector a+ , duration :: Duration+ , hands :: [Hand a]+ , leapId :: LeapId+ , normal :: Vector a+ , pointables :: [Pointable a]+ , progress :: a+ , radius :: a+ , state :: State+ }+ | Swipe+ {+ direction :: Vector a+ , duration :: Duration+ , hands :: [Hand a]+ , leapId :: LeapId+ , pointables :: [Pointable a]+ , position :: Vector a+ , speed :: a+ , startPosition :: Vector a+ , state :: State+ }+ | KeyTap+ {+ direction :: Vector a+ , duration :: Duration+ , hands :: [Hand a]+ , leapId :: LeapId+ , pointables :: [Pointable a]+ , position :: Vector a+ , progress :: a+ , state :: State+ }+ | ScreenTap+ {+ direction :: Vector a+ , duration :: Duration+ , hands :: [Hand a]+ , leapId :: LeapId+ , pointables :: [Pointable a]+ , position :: Vector a+ , progress :: a+ , state :: State+ }+ deriving (Eq, Ord, Read, Show)++instance FromJSON a => FromJSON (Gesture a) where+ parseJSON (Object o)+ | t == Just "circle" = Circle+ <$> o .: "center"+ <*> o .: "duration"+ <*> (map HandReference <$> o .: "handIds")+ <*> o .: "id"+ <*> o .: "normal"+ <*> (map PointableReference <$> o .: "pointableIds")+ <*> o .: "progress"+ <*> o .: "radius"+ <*> o .: "state"+ | t == Just "swipe" = Swipe+ <$> o .: "direction"+ <*> o .: "duration"+ <*> (map HandReference <$> o .: "handIds")+ <*> o .: "id"+ <*> (map PointableReference <$> o .: "pointableIds")+ <*> o .: "position"+ <*> o .: "speed"+ <*> o .: "startPosition"+ <*> o .: "state"+ | t == Just "keyTap" = KeyTap+ <$> o .: "direction"+ <*> o .: "duration"+ <*> (map HandReference <$> o .: "handIds")+ <*> o .: "id"+ <*> (map PointableReference <$> o .: "pointableIds")+ <*> o .: "position"+ <*> o .: "progress"+ <*> o .: "state"+ | t == Just "screenTap" = ScreenTap+ <$> o .: "direction"+ <*> o .: "duration"+ <*> (map HandReference <$> o .: "handIds")+ <*> o .: "id"+ <*> (map PointableReference <$> o .: "pointableIds")+ <*> o .: "position"+ <*> o .: "progress"+ <*> o .: "state"+ | otherwise = empty+ where+ t = "type" `M.lookup` o+ parseJSON _ = empty
+ src/System/Hardware/Leap/Event/Hand.hs view
@@ -0,0 +1,93 @@+{-|+Module : System.Hardware.Leap.Event.Hand+Copyright : (c) 2016 Brian W Bush+License : MIT+Maintainer : Brian W Bush <consult@brianwbush.info>+Stability : Stable+Portability : Portable+++Hand events for Leap Motion \<<https://www.leapmotion.com/product/desktop>\>, based on the Web Socket API \<<https://developer.leapmotion.com/documentation/javascript/supplements/Leap_JSON.html>\>.+-}+++{-# LANGUAGE OverloadedStrings #-}+++module System.Hardware.Leap.Event.Hand (+-- * Events+ Hand(..)+, Side(..)+) where+++import Control.Applicative (empty)+import Data.Aeson (FromJSON(..), Value(..), (.:))+import System.Hardware.Leap.Types (Basis, LeapId, Matrix, Vector)+++-- | Hands.+data Side = LeftHand | RightHand+ deriving (Bounded, Enum, Eq, Ord, Read, Show)++instance FromJSON Side where+ parseJSON (String "left" ) = return LeftHand+ parseJSON (String "right") = return RightHand+ parseJSON _ = empty+++-- | Hand tracking information. See \<<https://developer.leapmotion.com/documentation/javascript/supplements/Leap_JSON.html>\> for details.+data Hand a =+ HandReference+ {+ leapId :: LeapId+ }+ | Hand+ {+ armBasis :: Basis a+ , armWidth :: a+ , confidence :: a+ , direction :: Vector a+ , elbow :: Vector a+ , grabStrength :: a+ , leapId :: LeapId+ , palmNormal :: Vector a+ , palmPosition :: Vector a+ , palmVelocity :: Vector a+ , pinchStrength :: a+ , r :: Matrix a+ , s :: a+ , sphereCenter :: Vector a+ , sphereRadius :: a+ , stabilizedPalmPosition :: Vector a+ , t :: Vector a+ , timeVisible :: a+ , side :: Side+ , wrist :: Vector a+ }+ deriving (Eq, Ord, Read, Show)++instance FromJSON a => FromJSON (Hand a) where + parseJSON (Object o) =+ Hand+ <$> o .: "armBasis"+ <*> o .: "armWidth"+ <*> o .: "confidence"+ <*> o .: "direction"+ <*> o .: "elbow"+ <*> o .: "grabStrength"+ <*> o .: "id"+ <*> o .: "palmNormal"+ <*> o .: "palmPosition"+ <*> o .: "palmVelocity"+ <*> o .: "pinchStrength"+ <*> o .: "r"+ <*> o .: "s"+ <*> o .: "sphereCenter"+ <*> o .: "sphereRadius"+ <*> o .: "stabilizedPalmPosition"+ <*> o .: "t"+ <*> o .: "timeVisible"+ <*> o .: "type"+ <*> o .: "wrist"+ parseJSON _ = empty
+ src/System/Hardware/Leap/Event/Pointable.hs view
@@ -0,0 +1,136 @@+{-|+Module : System.Hardware.Leap.Event.Pointable+Copyright : (c) 2016 Brian W Bush+License : MIT+Maintainer : Brian W Bush <consult@brianwbush.info>+Stability : Stable+Portability : Portable+++Pointable events for Leap Motion \<<https://www.leapmotion.com/product/desktop>\>, based on the Web Socket API \<<https://developer.leapmotion.com/documentation/javascript/supplements/Leap_JSON.html>\>.+-}+++{-# LANGUAGE OverloadedStrings #-}+++module System.Hardware.Leap.Event.Pointable (+-- * Events+ Pointable(..)+, TouchZone(..)+, Finger(..)+) where+++import Control.Applicative (empty)+import Data.Aeson (FromJSON(..), Value(..), (.:))+import Data.Map.Strict (Map, fromList)+import System.Hardware.Leap.Event.Hand (Hand(HandReference))+import System.Hardware.Leap.Types (Basis, LeapId, Vector)++import qualified Data.HashMap.Strict as M (lookup)+++-- | Touch zones.+data TouchZone = None | Hovering | Touching+ deriving (Bounded, Enum, Eq, Ord, Read, Show)++instance FromJSON TouchZone where+ parseJSON (String "none" ) = return None+ parseJSON (String "hovering") = return Hovering+ parseJSON (String "touching") = return Touching+ parseJSON _ = empty+++-- | Fingers.+data Finger = Thumb | IndexFinger | MiddleFinger | RingFinger | Pinky+ deriving (Bounded, Enum, Eq, Ord, Read, Show)++instance FromJSON Finger where+ parseJSON (Number 0) = return Thumb+ parseJSON (Number 1) = return IndexFinger+ parseJSON (Number 2) = return MiddleFinger+ parseJSON (Number 3) = return RingFinger+ parseJSON (Number 4) = return Pinky+ parseJSON _ = empty+++-- | Pointable tracking information. See \<<https://developer.leapmotion.com/documentation/javascript/supplements/Leap_JSON.html>\> for details.+data Pointable a =+ PointableReference+ {+ leapId :: LeapId+ }+ | Finger+ {+ bases :: Map Finger (Basis a)+ , btipPosition :: Vector a+ , carpPosition :: Vector a+ , dipPosition :: Vector a+ , direction :: Vector a+ , extended :: Bool+ , hand :: Hand a+ , leapId :: LeapId+ , pointableLength :: a+ , mcpPosition :: Vector a+ , pipPosition :: Vector a+ , stabilizedTipPosition :: Vector a+ , timeVisible :: a+ , tipPosition :: Vector a+ , tipVelocity :: Vector a+ , touchDistance :: a+ , touchZone :: TouchZone+ , finger :: Finger+ , width :: a+ }+ | Tool+ {+ direction :: Vector a+ , hand :: Hand a+ , leapId :: LeapId+ , pointableLength :: a+ , stabilizedTipPosition :: Vector a+ , timeVisible :: a+ , tipPosition :: Vector a+ , tipVelocity :: Vector a+ , touchDistance :: a+ , touchZone :: TouchZone+ , width :: a+ }+ deriving (Eq, Ord, Read, Show)++instance FromJSON a => FromJSON (Pointable a) where+ parseJSON (Object o)+ | "tool" `M.lookup` o == Just (Bool True) = Tool+ <$> o .: "direction"+ <*> (HandReference <$> o .: "handId")+ <*> o .: "id"+ <*> o .: "length"+ <*> o .: "stabilizedTipPosition"+ <*> o .: "timeVisible"+ <*> o .: "tipPosition"+ <*> o .: "tipVelocity"+ <*> o .: "touchDistance"+ <*> o .: "touchZone"+ <*> o .: "width"+ | otherwise = Finger+ <$> (fromList . zip [minBound..maxBound] <$> o .: "bases")+ <*> o .: "btipPosition"+ <*> o .: "carpPosition"+ <*> o .: "dipPosition"+ <*> o .: "direction"+ <*> o .: "extended"+ <*> (HandReference <$> o .: "handId")+ <*> o .: "id"+ <*> o .: "length"+ <*> o .: "mcpPosition"+ <*> o .: "pipPosition"+ <*> o .: "stabilizedTipPosition"+ <*> o .: "timeVisible"+ <*> o .: "tipPosition"+ <*> o .: "tipVelocity"+ <*> o .: "touchDistance"+ <*> o .: "touchZone"+ <*> o .: "type"+ <*> o .: "width"+ parseJSON _ = empty
+ src/System/Hardware/Leap/Types.hs view
@@ -0,0 +1,41 @@+{-|+Module : System.Hardware.Leap.Event.Types+Copyright : (c) 2016 Brian W Bush+License : MIT+Maintainer : Brian W Bush <consult@brianwbush.info>+Stability : Stable+Portability : Portable+++Types for Leap Motion \<<https://www.leapmotion.com/product/desktop>\>, based on the Web Socket API \<<https://developer.leapmotion.com/documentation/javascript/supplements/Leap_JSON.html>\>.+-}+++module System.Hardware.Leap.Types (+-- * Types+ LeapId+, Duration+, Vector+, Basis+, Matrix+) where+++-- | ID for an item tracked by Leap.+type LeapId = Int+++-- | Measurement of time.+type Duration = Int+++-- | Three dimensional vector.+type Vector a = (a, a, a)+++-- | Three dimensionsional basis.+type Basis a = (Vector a, Vector a, Vector a)+++-- | Three dimensionsional rotation matrix.+type Matrix a = (Vector a, Vector a, Vector a)