hemokit (empty) → 0.4.0
raw patch · 10 files changed
+1196/−0 lines, 10 filesdep +HUnitdep +aesondep +basesetup-changed
Dependencies added: HUnit, aeson, base, base64-bytestring, bytestring, cairo, cipher-aes, conduit, criterion, deepseq, deepseq-generics, gtk, hemokit, hidapi, mtl, optparse-applicative, pretty-show, robot, split, svgcairo, transformers, vector, vector-fftw, websockets, xhb
Files
- Setup.hs +2/−0
- apps/Dump.hs +137/−0
- apps/FFT.hs +63/−0
- apps/Headmap.hs +134/−0
- apps/Mouse.hs +48/−0
- bench/Bench.hs +21/−0
- hemokit.cabal +160/−0
- src/Hemokit.hs +505/−0
- src/Hemokit/Start.hs +80/−0
- test/Tests.hs +46/−0
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ apps/Dump.hs view
@@ -0,0 +1,137 @@+{-# LANGUAGE NamedFieldPuns, TemplateHaskell #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++module Main where++import Control.Monad+import Data.Aeson (ToJSON (..), encode)+import qualified Data.ByteString.Char8 as BS8+import qualified Data.ByteString.Lazy.Char8 as BSL8+import qualified Data.ByteString.Base64 as Base64+import Data.List+import Data.List.Split (splitOn)+import Options.Applicative hiding (action)+import System.IO+import Text.Read+import Text.Show.Pretty++import Hemokit+import Hemokit.Start++import WebsocketUtils (makeJsonOrShowWSServer, JsonShowable (..))+++-- | Arguments for the EEG dump application.+data DumpArgs = DumpArgs+ { emotivArgs :: EmotivArgs+ , mode :: DumpMode -- ^ What to dump.+ , listDevices :: Bool -- ^ Do not do anything, print available devices.+ , json :: Bool -- ^ Whether to format the output as JSON.+ , serve :: Maybe (String, Int) -- ^ Serve via websockets on host:port.+ }++-- | Whether to dump raw data, hardware-sent packages or cumulative states.+data DumpMode = Raw | Packets | State deriving (Eq, Show)+++-- | Parser for `DumpArgs`.+dumpArgsParser :: Parser DumpArgs+dumpArgsParser = DumpArgs+ <$> emotivArgsParser+ <*> nullOption+ ( long "mode"+ <> reader parseDumpMode <> value State+ <> help "What to dump. Can be 'raw', 'packets', or 'state'" )+ <*> switch+ ( long "list"+ <> help "Show all available Emotiv devices and exit" )+ <*> switch+ ( long "json"+ <> help "Format output as JSON" )+ <*> (optional . nullOption)+ ( long "serve" <> metavar "HOST:PORT"+ <> eitherReader parseHostPort+ <> help ("Serve output via websockets, e.g. 127.0.0.1:1234 " +++ "(port 1234, only localhost) or 0.0.0.0:1234 (all interfaces)") )+ where+ -- TODO https://github.com/pcapriotti/optparse-applicative/issues/48+ eitherReader str2either = reader (either fail return . str2either)+++-- | `DumpMode` command line parser.+parseDumpMode :: Monad m => String -> m DumpMode+parseDumpMode s = case s of+ "raw" -> return Raw+ "packets" -> return Packets+ "state" -> return State+ _ -> fail "Mode is not valid. Must be 'raw', 'packets', or 'state'."+++-- | Parses host and port from a string like "0.0.0.0:1234".+parseHostPort :: String -> Either String (String, Int)+parseHostPort hostPort = case readMaybe portStr of+ Nothing -> Left $ show portStr ++ " is not a valid port number"+ Just p -> Right (host, p)+ where+ (host, portStr) = splitLast ":" hostPort++ splitLast :: String -> String -> (String, String)+ splitLast sep s = let sp = splitOn sep s -- splitOn never returns []+ in (intercalate sep (init sp), last sp)+++main :: IO ()+main = do+ DumpArgs{ emotivArgs+ , mode+ , listDevices+ , json+ , serve+ } <- execParser $ info (helper <*> dumpArgsParser)+ (progDesc "Dumps Emotiv data")++ if listDevices -- Only list devices+ then getEmotivDevices >>= putStrLn . ("Available devices:\n" ++) . ppShow+ else do++ e'device <- getEmotivDeviceFromArgs emotivArgs++ -- Do we have a device?+ case e'device of+ Left err -> error err+ Right device -> do++ -- Print to stdout or serve via websockets? Show the datatype or format via JSON?+ -- `output` accepts anything that's JSON-formattable and showable (wrapped in JsonShowable).+ output <- case serve of+ Nothing -> return (putStrLn . if json then BSL8.unpack . encode else show)+ Just (host, port) -> makeJsonOrShowWSServer host port json++ -- Packet loop+ forever $ do++ -- Output accumulative state, device-sent packet, or raw data?+ case mode of+ Packets -> do (_, packet) <- readEmotiv device+ output (JsonShowable packet)++ State -> do (state, _) <- readEmotiv device+ output (JsonShowable state)++ Raw -> do rawBytes <- readEmotivRaw device+ if json then output (JsonShowable rawBytes)+ else BS8.putStr (emotivRawDataBytes rawBytes)++ hFlush stdout+++-- * JSON instances++instance ToJSON EmotivPacket+instance ToJSON EmotivState++instance ToJSON EmotivRawData where+ toJSON = toJSON . Base64.encode . emotivRawDataBytes++instance ToJSON Sensor where+ toJSON = toJSON . show
+ apps/FFT.hs view
@@ -0,0 +1,63 @@+module Main where++import Control.Monad+import Control.Monad.Trans+import Data.Complex+import Data.Conduit+import qualified Data.Conduit.List as CL+import qualified Data.Vector as V+import Numeric.FFT.Vector.Unnormalized+import System.Environment+import Text.Printf++import Hemokit+++packets :: EmotivDevice -> Source IO EmotivState+packets d = forever (liftIO (readEmotiv d) >>= yield . fst)++buffer :: Monad m => Int -> Conduit a m [ a ]+buffer n = forever (CL.take n >>= yield)++printAll :: Sink [V.Vector Double] IO ()+printAll = awaitForever $ \tds -> liftIO $ putStrLn (unlines (map showFFT tds))+++-- Convert a length M list of length N vectors into a length N list of length M vectors.+transposeV :: Int -> [ V.Vector a ] -> [ V.Vector a ]+transposeV n vs = [ V.fromList (map (V.! i) vs) | i <- [ 0 .. n - 1 ] ]++showFFT :: V.Vector Double -> String+-- showFFT ms = map (toChar . (/(V.maximum ms))) $ V.toList ms+showFFT ms = unwords . map (formatNumber . (/ V.maximum ms)) $ V.toList ms+ where+ formatNumber n = printf "%2.0f" (n*100)+ toChar m+ | m < 0.25 = ' '+ | m < 0.5 = '.'+ | m < 0.75 = 'o'+ | otherwise = '#'++norm :: V.Vector Double -> V.Vector Double+norm v = V.map (subtract avg) v+ where+ avg = V.sum v / fromIntegral (V.length v)+++main :: IO ()+main = do+ args <- getArgs+ let model = if "--developer" `elem` args then Developer else Consumer++ devices <- getEmotivDevices+ device <- case devices of+ [] -> error "No devices found."+ _ -> openEmotivDevice model (last devices)++ let size = 256+ let fft = plan dftR2C size++ let sensorData = mapOutput (V.map fromIntegral . sensors) (packets device)+ let fftConduit = mapOutput (map (V.map magnitude . execute fft . norm) . transposeV 14) (buffer size)++ sensorData $= fftConduit $$ printAll
+ apps/Headmap.hs view
@@ -0,0 +1,134 @@+{-# LANGUAGE NamedFieldPuns #-}++module Main where++import Control.Concurrent+import Control.Monad+import Data.Vector ((!))+-- import Data.IORef+-- import qualified Data.Vector as V+import Graphics.Rendering.Cairo+import Graphics.UI.Gtk+-- import Graphics.UI.Gtk.Gdk.EventM+import Graphics.Rendering.Cairo.SVG++import Hemokit+++main :: IO ()+main = do+ svg <- svgNewFromFile "images/head-map.svg"+ let (width, height) = svgGetSize svg+ drawSensor (xi, yi) _sensor qual = do+ let (x, y) = (fromIntegral xi, fromIntegral yi)+ -- name = show sensor ++ " " ++ show qual+ name = show qual+ setRed >> drawCircle x y 15+ TextExtents{ textExtentsWidth = w } <- textExtents name+ moveTo (x - 8 - w/2) (y - 8)+ setBlack >> drawStr name++ emotivStateMvar <- newEmptyMVar+ forkIO $ do+ putMVar emotivStateMvar undefined+ putStrLn "Waiting for EEG data..."+ withDataFromLastEEG Consumer (void . swapMVar emotivStateMvar . fst)++ run width height $ \window -> do+ _ <- svgRender svg+ liftIO $ flush++ EmotivState{ counter, qualities } <- liftIO $ readMVar emotivStateMvar+ liftIO $ print (counter, qualities)++ forM_ allSensors $ \s ->+ drawSensor (sensorPosition (width, height) s) s (qualities ! (fromEnum s))++ liftIO $ flush >> widgetQueueDraw window+++sensorPosition :: (Int, Int) -> Sensor -> (Int, Int)+sensorPosition (width, height) sensor = case sensor of++ -- Left side+ AF3 -> ( 125 , height - 434 )+ F3 -> ( 145 , height - 380 )+ F7 -> ( 77 , height - 360 )+ FC5 -> ( 107 , height - 318 )+ T7 -> ( 55 , height - 250 )+ -- CMS -> ( 51 , height - 178 )+ -- F7 -> ( 51 , height - 178 )+ -- CMS -> ( 102 , height - 153 )+ P7 -> ( 80 , height - 93 )+ O1 -> ( 147 , height - 35 )++ -- Right side+ AF4 -> yMirror AF3+ F4 -> yMirror F3+ F8 -> yMirror F7+ FC6 -> yMirror FC5+ T8 -> yMirror T7+ -- DRL -> yMirror CMS+ -- F8 -> yMirror F7+ -- DRL -> yMirror CMS+ P8 -> yMirror P7+ O2 -> yMirror O1+ where+ yMirror s = let (x,y) = sensorPosition (width, height) s+ in (width - x, y)++++drawCircle :: Double -> Double -> Double -> Render ()+drawCircle x y radius = do+ arc x y radius 0 (2 * pi)+ -- stroke+ fill+ -- fillPreserve++++run :: Int -> Int -> (Window -> Render ()) -> IO ()+run width height renderAct = do+ _ <- initGUI+ win <- windowNew+ vbox <- vBoxNew False 0+ closeButton <- buttonNewWithLabel "Close"+ onClicked closeButton (widgetDestroy win)+ canvas <- drawingAreaNew+ _ <- canvas `onSizeRequest` return (Requisition width height)+ _ <- canvas `on` exposeEvent $ tryEvent $ updateCanvas canvas (renderAct win)++ containerAdd vbox closeButton+ containerAdd vbox canvas+ containerAdd win vbox++ widgetShow canvas+ widgetShowAll win+ onDestroy win mainQuit+ -- flush+ mainGUI+ -- Flush all commands that are waiting to be sent to the graphics server.+ -- This ensures that the window is actually closed before ghci displays the+ -- prompt again.++ where+ updateCanvas :: DrawingArea -> Render () -> EventM EExpose ()+ updateCanvas canvas act = liftIO $ do+ win <- widgetGetDrawWindow canvas+ renderWithDrawable win act+++setRed :: Render ()+setRed = do+ setSourceRGB 1 0 0++setBlack :: Render ()+setBlack = do+ setSourceRGB 0 0 0+++drawStr :: String -> Render ()+drawStr txt = do+ lay <- createLayout txt+ showLayout lay
+ apps/Mouse.hs view
@@ -0,0 +1,48 @@+module Main where++import Control.Concurrent (threadDelay, forkIO)+import Control.Monad+import Data.IORef+import Graphics.XHB.Connection (connect)+import System.Environment+import System.IO+import Test.Robot+import Text.Show.Pretty (ppShow)++import Hemokit+++main :: IO ()+main = do+ args <- getArgs+ let model = if "--developer" `elem` args then Developer else Consumer++ devices <- getEmotivDevices++ putStrLn $ "AvailableDevices:\n" ++ ppShow devices++ device <- openEmotivDevice model $ case devices of d:_ -> d+ [] -> error "no Epoc devices found"++ m'xConnection <- connect+ xy <- newIORef (0,0)++ case m'xConnection of+ Nothing -> return ()+ Just xc -> void . forkIO . forever $ do+ (x, y) <- readIORef xy+ print (x, y)+ writeIORef xy (0, 0)+ runRobotWithConnection (moveBy ((-x) `quot` 10) (y `quot` 10)) xc+ threadDelay 10000++ forever $ do+ (state, _) <- readEmotiv device+ -- print (qualities state)+ print state+ -- putStrLn $ show (gyroX state) ++ " " ++ show (gyroY state)+ hFlush stdout++ modifyIORef' xy $ \(x,y) -> (x + gyroX state, y + gyroY state)++ return (battery state, qualities state)
+ bench/Bench.hs view
@@ -0,0 +1,21 @@+{-# LANGUAGE OverloadedStrings #-}++module Main (main) where++import Criterion.Main+import Data.Maybe++import Hemokit+++main :: IO ()+main = defaultMain+ [ bench "parsePacket" $ nf parsePacket rawPacket1+ , bench "decrypt" $ nf (decrypt _SERIAL Consumer) encryptedPacket1+ ]+ where+ _SERIAL = fromJust $ makeSerialNumber "SN201211154288GM"++ rawPacket1 = makeEmotivRawData "|\147~E\ETB\184\155\230y\185\247\249\&1@\NUL\NUL\STX\NUL\184\ACK\158ms\221\246\183\156\RSOgir"++ encryptedPacket1 = "\170\182\217\GS \170\NULR\237\130\&7\191\227}K#\228\153Ew\188_\228\129\232\186K\246\135\DEL\129z"
+ hemokit.cabal view
@@ -0,0 +1,160 @@+name: hemokit+version: 0.4.0+license: MIT+copyright: 2013 Niklas Hambüchen <mail@nh2.me>, Patrick Chilton <chpatrick@gmail.com>+author: Niklas Hambüchen <mail@nh2.me>, Patrick Chilton <chpatrick@gmail.com>+maintainer: Niklas Hambüchen <mail@nh2.me>+category: Bioinformatics+build-type: Simple+stability: experimental+tested-with: GHC==7.6.2+cabal-version: >= 1.10+homepage: https://github.com/nh2/haskell-hemokit+bug-reports: https://github.com/nh2/haskell-hemokit/issues+synopsis: Haskell port of the Emokit EEG project+description:+ This package allows reading raw data from the Emotiv EPOC EEG devices.+ .+ It is inspired and based on the code of the Emokit project+ (<https://github.com/openyou/emokit>), but entirely written in Haskell.+ .+ It contains an extensive, well-documented library for connecting to devices,+ decrypting the stream, and parsing the relevant data out.+ .+ Data can be read from a given device via HIDAPI-hidraw or a dump file;+ reading from multiple devices is supported and when only one EEG is to+ be used, the correct device is automatically selected.+ .+ There is also an executable, @hemokit-dump@, that can print out+ .+ * raw data+ .+ * incremental packets as sent from the device+ .+ * the cumulative /state/ of the EEG+ .+ in both their plain form and as JSON, and optionally serve any of this+ via Websockets.++source-repository head+ type: git+ location: git://github.com/nh2/hemokit.git+++library+ exposed-modules:+ Hemokit+ Hemokit.Start+ build-depends:+ base >= 4 && < 5+ , bytestring >= 0.9.2.1+ , cipher-aes >= 0.1.7+ , deepseq >= 1.2+ , deepseq-generics >= 0.1+ , hidapi >= 1.0+ , optparse-applicative >= 0.5.2.1+ , vector >= 0.9+ hs-source-dirs:+ src+ default-language: Haskell2010+ ghc-options: -Wall+++executable hemokit-mouse+ default-language: Haskell2010+ hs-source-dirs:+ apps+ main-is:+ Mouse.hs+ build-depends:+ base+ , hemokit+ , pretty-show >= 1.0+ , robot >= 1.0.1.1+ , xhb >= 0.5.2012.11.23+ ghc-options: -Wall+++executable hemokit-dump+ default-language: Haskell2010+ hs-source-dirs:+ apps+ main-is:+ Dump.hs+ build-depends:+ base+ , hemokit+ , aeson >= 0.6.1.0+ , base64-bytestring >= 1.0.0.1+ , bytestring >= 0.9.2.1+ , optparse-applicative >= 0.5.2.1+ , pretty-show >= 1.0+ , split >= 0.2.2+ , transformers >= 0.3.0.0+ , websockets >= 0.7.3.0+ ghc-options: -Wall+++executable hemokit-fft+ default-language: Haskell2010+ hs-source-dirs:+ apps+ main-is:+ FFT.hs+ build-depends:+ base+ , hemokit+ , conduit+ , mtl >= 2.1.2+ , pretty-show >= 1.0+ , vector >= 0.9+ , vector-fftw >= 0.1.3.1+ ghc-options: -Wall+++executable hemokit-headmap+ default-language: Haskell2010+ hs-source-dirs:+ apps+ main-is:+ Headmap.hs+ build-depends:+ base+ , hemokit+ , cairo >= 0.12.4+ , gtk >= 0.12.4+ , mtl >= 2.1.2+ , pretty-show >= 1.0+ , svgcairo >= 0.12.1.1+ , vector >= 0.9+ ghc-options: -Wall+++test-suite tests+ default-language: Haskell2010+ type: exitcode-stdio-1.0+ hs-source-dirs:+ test+ main-is:+ Tests.hs+ build-depends:+ base+ , hemokit+ , bytestring >= 0.9.2.1+ , HUnit >= 1.2+ , vector >= 0.9+ ghc-options: -Wall+++benchmark bench+ default-language: Haskell2010+ type: exitcode-stdio-1.0+ hs-source-dirs:+ bench+ main-is:+ Bench.hs+ build-depends:+ base+ , hemokit+ , criterion >= 0.8.0.0+ ghc-options: -Wall
+ src/Hemokit.hs view
@@ -0,0 +1,505 @@+{-# LANGUAGE NamedFieldPuns, TupleSections, DeriveDataTypeable, DeriveGeneric #-}++-- | A library for reading from an Emotic EPOC EEG.+--+-- * Use `getEmotivDevices` to list available EEGs.+--+-- * Use `openEmotivDevice` to open a device for reading.+--+-- * Use `readEmotiv` read from an open device.+--+-- * You will obtain `EmotivPacket`s and `EmotivState`s.+module Hemokit+ ( -- * Opening and reading from EEGs+ _EMOTIV_VENDOR_ID+ , _EMOTIV_PRODUCT_ID+ , EmotivDeviceInfo (..)+ , EmotivRawDevice (..)+ , EmotivDevice (..)+ , getEmotivDevices+ , openEmotivDevice+ , openEmotivDeviceFile+ , readEmotiv+ , EmotivException (..)+ , SerialNumber ()+ , makeSerialNumber+ , makeSerialNumberFromString+ , deviceInfoSerial++ -- EEG models+ , EmotivModel (..)++ -- * EEG data+ , EmotivPacket (..)+ , EmotivState (..)+ , Sensor (..)+ , allSensors++ -- * Dealing with (decrypted) raw data+ , EmotivRawData (..)+ , readEmotivRaw+ , makeEmotivRawData+ , parsePacket+ , updateEmotivState++ -- * Encrypted raw data+ , decrypt++ -- * Internals+ , BitMask (..)+ , getSensorMask+ , qualityMask+ , getLevel+ , batteryValue+ , qualitySensorFromByte0++ -- * Interactive use+ , withDataFromLastEEG+ ) where++import Control.Applicative+import Control.DeepSeq.Generics+import Control.Exception+import Control.Monad+import Crypto.Cipher.AES+import Data.Bits ((.|.), (.&.), shiftL, shiftR)+import Data.Char+import Data.Data+import Data.IORef+import Data.List+import Data.Ord (comparing)+import Data.Vector (Vector)+import qualified Data.Vector as V+import Data.Word+import Data.ByteString as BS (ByteString, index)+import qualified Data.ByteString as BS+import qualified Data.ByteString.Char8 as BS8+import GHC.Generics (Generic)+import qualified System.HIDAPI as HID+import System.HIDAPI (DeviceInfo (..))+import System.IO+++-- | Whether the EPOC is a consumer or developer model.+--+-- This affects how the EEG data is to be decrypted.+--+-- You can check if you are using the correct model by seeing if the packet+-- `counter` increases from 0 until 128 on subsequent packets.+data EmotivModel = Consumer | Developer deriving (Eq, Show, Generic)+++-- | A valid Emotiv serial number. 16 bytes.+newtype SerialNumber = SerialNumber ByteString deriving (Eq, Show, Generic)++-- | Checks an Emotiv serial, returning a `SerialNumber` if it's valid.+makeSerialNumber :: ByteString -> Maybe SerialNumber+makeSerialNumber b | BS.length b == 16 = Just $ SerialNumber b+ | otherwise = Nothing++-- | Like `makeSerialNumber`, using a `String`.+makeSerialNumberFromString :: String -> Maybe SerialNumber+makeSerialNumberFromString = makeSerialNumber . BS8.pack+++-- | Takes a 32 bytes encrypted EEG data, returns 32 bytes decrypted EEG data.+decrypt :: SerialNumber -> EmotivModel -> ByteString -> EmotivRawData+decrypt (SerialNumber num) typ encrypted32bytes = makeEmotivRawData decrypted32bytes+ where+ decrypted32bytes = BS.concat [decryptECB key left, decryptECB key right]++ (left, right) = BS.splitAt 16 encrypted32bytes+ sn x | x >= 0 = index num x+ | otherwise = sn (BS.length num + x)+ c = fromIntegral . ord+ key = initKey . BS.pack $ start ++ middle ++ end++ start = [ sn (-1), 0, sn (-2)]+ middle = case typ of+ Consumer -> [ c 'T', sn (-3), 0x10, sn (-4), c 'B', sn (-1), 0 , sn (-2), c 'H']+ Developer -> [ c 'H', sn (-1), 0 , sn (-2), c 'T', sn (-3), 0x10, sn (-4), c 'B']+ end = [ sn (-3), 0, sn (-4), c 'P']++-- | The sensors of an Emotiv EPOC.+-- Uses the names from the International 10-20 system.+data Sensor+ = F3+ | FC5+ | AF3+ | F7+ | T7+ | P7+ | O1+ | O2+ | P8+ | T8+ | F8+ | AF4+ | FC6+ | F4+ deriving (Eq, Enum, Bounded, Ord, Show, Generic)++-- | Contains all `Sensor`s.+allSensors :: [Sensor]+allSensors = [minBound .. maxBound]+++-- | Describes the indices of bits to make up a certain value.+newtype BitMask = BitMask [Word8] deriving (Eq, Show)++-- | Describes which bits in a raw data packet make up the given sensor.+getSensorMask :: Sensor -> BitMask+getSensorMask s = BitMask $ case s of+ F3 -> [10, 11, 12, 13, 14, 15, 0, 1, 2, 3, 4, 5, 6, 7]+ FC5 -> [28, 29, 30, 31, 16, 17, 18, 19, 20, 21, 22, 23, 8, 9]+ AF3 -> [46, 47, 32, 33, 34, 35, 36, 37, 38, 39, 24, 25, 26, 27]+ F7 -> [48, 49, 50, 51, 52, 53, 54, 55, 40, 41, 42, 43, 44, 45]+ T7 -> [66, 67, 68, 69, 70, 71, 56, 57, 58, 59, 60, 61, 62, 63]+ P7 -> [84, 85, 86, 87, 72, 73, 74, 75, 76, 77, 78, 79, 64, 65]+ O1 -> [102, 103, 88, 89, 90, 91, 92, 93, 94, 95, 80, 81, 82, 83]+ O2 -> [140, 141, 142, 143, 128, 129, 130, 131, 132, 133, 134, 135, 120, 121]+ P8 -> [158, 159, 144, 145, 146, 147, 148, 149, 150, 151, 136, 137, 138, 139]+ T8 -> [160, 161, 162, 163, 164, 165, 166, 167, 152, 153, 154, 155, 156, 157]+ F8 -> [178, 179, 180, 181, 182, 183, 168, 169, 170, 171, 172, 173, 174, 175]+ AF4 -> [196, 197, 198, 199, 184, 185, 186, 187, 188, 189, 190, 191, 176, 177]+ FC6 -> [214, 215, 200, 201, 202, 203, 204, 205, 206, 207, 192, 193, 194, 195]+ F4 -> [216, 217, 218, 219, 220, 221, 222, 223, 208, 209, 210, 211, 212, 213]++-- | Describes which bits in a raw data packat make up a sensor quality value.+qualityMask :: BitMask+qualityMask = BitMask [99, 100, 101, 102, 103, 104, 105, 106, 107, 108, 109, 110, 111, 112]+++-- | Extracts the sensor value for the given sensor from Emotiv raw data.+getLevel :: EmotivRawData -> BitMask -> Int+getLevel (EmotivRawData bytes32) (BitMask sensorBits) = foldr f 0 sensorBits+ where+ f :: Word8 -> Int -> Int+ f bitNo level = (level `shiftL` 1) .|. int (bitAt b o)+ where+ b = (bitNo `shiftR` 3) + 1 :: Word8 -- div by 8 to get byte number, skip first byte (counter)+ o = bitNo .&. 7 :: Word8 -- mod by 8 to get bit offset++ bitAt :: Word8 -> Word8 -> Word8+ bitAt byte bitOffset = ((bytes32 `index` int byte) `shiftR` int bitOffset) .&. 1+++-- | `fromIntegral` shortcut.+int :: (Integral a) => a -> Int+int = fromIntegral+++-- TODO this might have to be adjusted+-- | Parses a battery percentage value from a byte.+batteryValue :: Word8 -> Int+batteryValue batteryByte = case batteryByte of+ b | b >= 248 -> 100+ 247 -> 99+ 246 -> 97+ 245 -> 93+ 244 -> 89+ 243 -> 85+ 242 -> 82+ 241 -> 77+ 240 -> 72+ 239 -> 66+ 238 -> 62+ 237 -> 55+ 236 -> 46+ 235 -> 32+ 234 -> 20+ 233 -> 12+ 232 -> 6+ 231 -> 4+ 230 -> 3+ 229 -> 2+ 228 -> 1+ 227 -> 1+ 226 -> 1+ _ -> 0+++-- | Which sensor's quality is transmitted in the packet+-- (depends on first byte, the packet counter).+qualitySensorFromByte0 :: Word8 -> Maybe Sensor+qualitySensorFromByte0 packetNo = case packetNo of+ 0 -> Just F3+ 1 -> Just FC5+ 2 -> Just AF3+ 3 -> Just F7+ 4 -> Just T7+ 5 -> Just P7+ 6 -> Just O1+ 7 -> Just O2+ 8 -> Just P8+ 9 -> Just T8+ 10 -> Just F8+ 11 -> Just AF4+ 12 -> Just FC6+ 13 -> Just F4+ 14 -> Just F8+ 15 -> Just AF4+ 64 -> Just F3+ 65 -> Just FC5+ 66 -> Just AF3+ 67 -> Just F7+ 68 -> Just T7+ 69 -> Just P7+ 70 -> Just O1+ 71 -> Just O2+ 72 -> Just P8+ 73 -> Just T8+ 74 -> Just F8+ 75 -> Just AF4+ 76 -> Just FC6+ 77 -> Just F4+ 78 -> Just F8+ 79 -> Just AF4+ 80 -> Just FC6+ _ -> Nothing+ -- TODO check why FC6 is the only one that appears 3 times.++++-- | Contains the data of a single packet sent from the device.+-- Accumulated data (the current state) is available in `EmotivState`.+data EmotivPacket = EmotivPacket+ { packetCounter :: Int -- ^ counts up from 0 to 127 (128 Hz)+ , packetBattery :: Maybe Int -- ^ the current battery percentage+ , packetGyroX :: Int -- ^ turning "left" gives positive numbers+ , packetGyroY :: Int -- ^ turning "down" gives positive numbers+ , packetSensors :: Vector Int -- ^ EEG sensor values+ , packetQuality :: Maybe (Sensor, Int) -- ^ EEG sensor-to-skin connectivity+ } deriving (Eq, Show, Generic)+++-- | Contains the "current state" of the EEG, cumulateively updated by+-- incoming `EmotivPacket`s.+data EmotivState = EmotivState+ { counter :: Int -- ^ counts up from 0 to 127 (128 Hz)+ , battery :: Int -- ^ the current battery percentage+ , gyroX :: Int -- ^ turning "left" gives positive numbers+ , gyroY :: Int -- ^ turning "down" gives positive numbers+ , sensors :: Vector Int -- ^ EEG sensor values+ , qualities :: Vector Int -- ^ EEG sensor-to-skin connectivity+ } deriving (Eq, Show, Generic)+++-- | Wraps (unencrypted) Emotiv raw data. Ensures that it is 32 bytes.+newtype EmotivRawData = EmotivRawData+ { emotivRawDataBytes :: ByteString+ } deriving (Eq, Show, Generic)+++-- | Treat a `ByteString` as Emotiv raw data.+-- Errors if the input is non 32 bytes.+makeEmotivRawData :: ByteString -> EmotivRawData+makeEmotivRawData bytes+ | BS.length bytes /= 32 = error "Emotiv raw data must be 32 bytes"+ | otherwise = EmotivRawData bytes+++-- I improved the gyro like this:+-- https://github.com/openyou/emokit/commit/b023a3c195410147dae44a3ce3a6d72f7c16e441++-- | Parses an `EmotivPacket` from raw bytes.+parsePacket :: EmotivRawData -> EmotivPacket+parsePacket raw@(EmotivRawData bytes32) = EmotivPacket+ { packetCounter = if is128c then 128 else fromIntegral byte0+ , packetBattery = if is128c then Just (batteryValue byte0) else Nothing+ , packetGyroX = ((int (byte 29) `shiftL` 4) .|. int (byte 31 `shiftR` 4)) - 1652 -- TODO check this hardcoding+ , packetGyroY = ((int (byte 30) `shiftL` 4) .|. int (byte 31 .&. 0x0F)) - 1681+ , packetSensors = V.fromList [ getLevel raw (getSensorMask s) | s <- allSensors ]+ , packetQuality = (, getLevel raw qualityMask) <$> qualitySensorFromByte0 byte0+ }+ where+ byte0 = byte 0+ byte n = bytes32 `index` n+ is128c = byte0 .&. 128 /= 0 -- Is it the packet which would be sequence no 128?+ -- If so, then byte0 is the battery value.+++-- | The USB vendor ID of the Emotiv EPOC.+_EMOTIV_VENDOR_ID :: HID.VendorID+_EMOTIV_VENDOR_ID = 8609++-- | The USB product ID of the Emotiv EPOC.+_EMOTIV_PRODUCT_ID :: HID.ProductID+_EMOTIV_PRODUCT_ID = 1+++-- | Emotiv related errors.+data EmotivException+ = InvalidSerialNumber HID.SerialNumber -- ^ Serial does not have right format.+ | CouldNotReadSerial HID.DevicePath -- ^ We could not read the serial from the device.+ | OtherEmotivException String+ deriving (Data, Typeable, Generic)++instance Exception EmotivException++instance Show EmotivException where+ show (InvalidSerialNumber sn) = "Emotiv ERROR: the device serial number " ++ sn ++ " does not look valid"+ show (CouldNotReadSerial path) = "Emotiv ERROR: could not read serial number of device " ++ path ++ ". Maybe you are not running as root?"+ show (OtherEmotivException err) = "Emotiv ERROR: " ++ err+++-- | Identifies an Emotiv device.+data EmotivDeviceInfo = EmotivDeviceInfo+ { hidapiDeviceInfo :: DeviceInfo -- ^ The hidapi device info.+ } deriving (Show, Generic)+++-- | An "open" data source to read bytes from.+data EmotivRawDevice+ = HidapiDevice+ { hidapiDevice :: HID.Device -- ^ The open hidapi device.+ }+ | HandleDevice+ { handleDevice :: Handle -- ^ A conventional `Handle`, e.g. an open file.+ } deriving (Generic)+++-- | Identifies an open Emotiv device.+-- Also contains the cumulative `EmotivState` of the EEG.+data EmotivDevice = EmotivDevice+ { rawDevice :: EmotivRawDevice -- ^ Where we get our data from, some form of "open handle".+ , serial :: SerialNumber -- ^ The EEG's serial.+ , emotivModel :: EmotivModel -- ^ Whether the EEG is a consumer or developer model.+ , stateRef :: IORef (Maybe EmotivState) -- ^ The EEG's cumulative state.+ } deriving (Generic)+++-- | Conveniently expose the serial number of a device.+deviceInfoSerial :: EmotivDeviceInfo -> Maybe SerialNumber+deviceInfoSerial = (>>= makeSerialNumberFromString) . serialNumber . hidapiDeviceInfo+++-- | Lists all EPOC devices, ordered by interface number.+-- If you do not actively choose amongst them, the last one is usually the one+-- you want (especially if only 1 EEG is connected).+getEmotivDevices :: IO [EmotivDeviceInfo]+getEmotivDevices = map EmotivDeviceInfo+ . sortBy (comparing interfaceNumber)+ <$> HID.enumerate (Just _EMOTIV_VENDOR_ID) (Just _EMOTIV_PRODUCT_ID)+++-- | Opens a given Emotiv device.+-- Returns an `EmotivDevice` to read from with `readEmotiv`.+openEmotivDevice :: EmotivModel -> EmotivDeviceInfo -> IO EmotivDevice+openEmotivDevice model EmotivDeviceInfo{ hidapiDeviceInfo } = case hidapiDeviceInfo of+ DeviceInfo{ serialNumber = Nothing, path } -> throwIO $ CouldNotReadSerial path+ DeviceInfo{ serialNumber = Just sn } ->+ case makeSerialNumberFromString sn of+ Nothing -> throwIO $ InvalidSerialNumber sn+ Just s -> do hidDev <- HID.openDeviceInfo hidapiDeviceInfo+ stateRef <- newIORef Nothing+ return $ EmotivDevice+ { rawDevice = HidapiDevice hidDev+ , serial = s+ , stateRef = stateRef+ , emotivModel = model+ }+++-- | Creates an `EmotivDevice` device from a path, e.g. a device like+-- @/dev/hidraw1@ or a normal file containing dumped binary data.+openEmotivDeviceFile :: EmotivModel -> SerialNumber -> String -> IO EmotivDevice+openEmotivDeviceFile model sn path = do+ h <- openFile path ReadMode+ stateRef <- newIORef Nothing+ return $ EmotivDevice+ { rawDevice = HandleDevice h+ , serial = sn+ , stateRef = stateRef+ , emotivModel = model+ }+++-- | Reads one 32 byte packet from the device and decrypts it to raw data.+readEmotivRaw :: EmotivDevice -> IO EmotivRawData+readEmotivRaw EmotivDevice{ rawDevice, serial, emotivModel } = do++ d32 <- case rawDevice of HidapiDevice d -> HID.read d 32+ HandleDevice d -> BS.hGet d 32++ return $ decrypt serial emotivModel d32+++-- | Given a device and a Emotiv raw data, parses the raw data into an+-- `EmotivPacket` and updates the cumulative `EmotivState` that we maintain+-- for that device.+--+-- Care should be taken that raw data is fed into this function in the right+-- order (e.g. respecting the EEG's increasing sequence numbers and quality+-- updates).+--+-- This function is only neededif you want to obtain both raw data and+-- parsed packages.+-- If you are not interested in raw data, use `readEmotiv` instead.+--+-- Returns both the packet read from the device and the updated state.+updateEmotivState :: EmotivDevice -> EmotivRawData -> IO (EmotivState, EmotivPacket)+updateEmotivState EmotivDevice{ stateRef } rawData = do++ let p = parsePacket rawData++ -- Update accumulative state++ lastState <- readIORef stateRef++ let lastBattery = maybe 0 battery lastState+ lastQualities = maybe (V.replicate (length allSensors) 0) qualities lastState++ newState = EmotivState+ { counter = packetCounter p+ , battery = maybe lastBattery id (packetBattery p)+ , gyroX = packetGyroX p+ , gyroY = packetGyroY p+ , sensors = packetSensors p+ -- We can't get around an O(n) qualities vector copy here+ -- if we want `Eq EmotivState`. It's small enough anyway.+ , qualities = lastQualities `deepseq` case packetQuality p of+ Nothing -> lastQualities+ Just (sensor, l) -> lastQualities V.// [(fromEnum sensor, l)]+ }++ writeIORef stateRef (Just newState)++ return (newState, p)+++-- | Reads one 32 byte packet from the device, parses the raw bytes into an+-- `EmotivPacket` and updates the cumulative `EmotivState` that we maintain+-- for that device.+--+-- Returns both the packet read from the device and the updated state.+readEmotiv :: EmotivDevice -> IO (EmotivState, EmotivPacket)+readEmotiv device = updateEmotivState device =<< readEmotivRaw device+++-- | Opens and reads from the last available device, giving all data from it+-- to the given function.+--+-- Intended for use with ghci.+--+-- Examples:+--+-- >withDataFromLastEEG Consumer print+-- >withDataFromLastEEG Consumer (print . packetQuality . snd)+-- >withDataFromLastEEG Consumer (putStrLn . unwords . map show . V.toList . qualities . fst)+withDataFromLastEEG :: EmotivModel -> ((EmotivState, EmotivPacket) -> IO a) -> IO a+withDataFromLastEEG model f = do+ devices <- getEmotivDevices+ device <- case devices of+ [] -> error "No devices found."+ _ -> openEmotivDevice model (last devices)+ forever $ readEmotiv device >>= f+++-- * NFData instances+instance NFData EmotivDeviceInfo where rnf = genericRnf+instance NFData EmotivException where rnf = genericRnf+instance NFData EmotivPacket where rnf = genericRnf+instance NFData EmotivRawData where rnf = genericRnf+instance NFData EmotivState where rnf = genericRnf+instance NFData Sensor where rnf = genericRnf
+ src/Hemokit/Start.hs view
@@ -0,0 +1,80 @@+{-# LANGUAGE NamedFieldPuns #-}++-- | Some convenience for building applications that want to read Emotiv data.+--+-- You can use this if you are writing an EEG application and don't want to do+-- the whole device selection / opening yourself.+module Hemokit.Start+ ( EmotivArgs (..)+ , emotivArgsParser+ , parseModel+ , getEmotivDeviceFromArgs+ ) where++import Data.List+import Options.Applicative++import Hemokit hiding (serial)+++-- | Commonly used options for EEG command line applications.+-- Mainly deals with input selection.+data EmotivArgs = EmotivArgs+ { model :: EmotivModel -- ^ What model to use for decryption.+ , serial :: Maybe SerialNumber -- ^ What serial to use for decryption.+ -- Also allows to pick a certain device.+ , fromFile :: Maybe FilePath -- ^ Use the given device or dump file for input.+ -- If not given, HIDAPI is used.+ } deriving (Eq, Show)+++-- | EEG model command line parser.+parseModel :: Monad m => String -> m EmotivModel+parseModel s = case s of+ "consumer" -> return Consumer+ "developer" -> return Developer+ _ -> fail "Model is not valid. Must be 'consumer' or 'developer'."+++-- | Command line parser for EEG selection. See `EmotivArgs`.+emotivArgsParser :: Parser EmotivArgs+emotivArgsParser = EmotivArgs+ <$> nullOption+ ( long "model" <> metavar "MODEL"+ <> reader parseModel <> value Consumer+ <> help "Consumer or Developer model, Consumer by default" )+ <*> (optional . nullOption)+ ( long "serial" <> metavar "SERIALNUMBER"+ <> maybeReader makeSerialNumberFromString "Serial number of has invalid format"+ <> help "The serial to use. If no --from-file is given, this will select the device" )+ <*> (optional . strOption)+ ( long "from-file" <> metavar "PATH"+ <> help "The file path to read from (e.g. /dev/hidraw0 or myfile.dump)" )+ where+ maybeReader mbFn msg = reader $ maybe (fail msg) pure . mbFn+++-- | Depending on some common EEG-choice-related user input, list devices or+-- try to open the correct device.+getEmotivDeviceFromArgs :: EmotivArgs -> IO (Either String EmotivDevice)+getEmotivDeviceFromArgs EmotivArgs{ model, serial, fromFile } = case fromFile of++ -- File given, use device file / file handle+ Just f | Just s <- serial -> Right <$> openEmotivDeviceFile model s f+ | otherwise -> fail "A serial number must be provided when using --from-file"++ -- No file given, use HIDAPI to select the device+ Nothing -> do+ devices <- getEmotivDevices++ case devices of+ [] -> fail "No devices found."+ _ -> case serial of++ -- Pick the device with the serial the user wants+ Just s -> case find ((Just s ==) . deviceInfoSerial) devices of+ Nothing -> fail $ "No device with serial " ++ show s+ Just d -> Right <$> openEmotivDevice model d++ -- The user selected no serial, we just use the last device+ _ -> Right <$> openEmotivDevice model (last devices)
+ test/Tests.hs view
@@ -0,0 +1,46 @@+{-# LANGUAGE OverloadedStrings #-}++module Main (main) where++import Data.Maybe+import qualified Data.Vector as V+import Test.Hspec+import Test.HUnit++import Hemokit+++_SERIAL :: SerialNumber+_SERIAL = fromJust $ makeSerialNumber "SN201211154288GM"+++main :: IO ()+main = hspec $ do++ describe "decrypt" $ do++ it "decrypts 0123456789abcdef0123456789abcdef" $ do++ let b32 = "0123456789abcdef0123456789abcdef"+ expected = "\SUBp\176Ei\155%\183\237\145\185\166:\247eQ\SUBp\176Ei\155%\183\237\145\185\166:\247eQ"++ emotivRawDataBytes (decrypt _SERIAL Consumer b32) @?= expected+++ describe "decrypting and parsing" $ do++ let encrypted = "S\a\205\165\195\182\244\DC4\NAKo\255K\\\247\146>tB\144q\165-\192\221\CANSa\150V,@\180"+ decrypted = decrypt _SERIAL Consumer encrypted+ decrypted_expected = "P}::\199\183\221\193|!\250h\205\NUL\NUL\NUL\STX\ENQX\r\162E|\218)\ETB\155\US\224gi9"+ packet_expected = EmotivPacket+ { packetRawData = makeEmotivRawData decrypted_expected+ , packetCounter = 80+ , packetBattery = Nothing+ , packetGyroX = -1+ , packetGyroY = 8+ , packetSensors = V.fromList [8014,9132,7903,7617,7944,8102,9012,8277,8246,8773,7990,8849,7788,8160]+ , packetQuality = Just (FC6, 0)+ }++ it "decrypts a valid packet" $ emotivRawDataBytes decrypted @?= decrypted_expected+ it "parses a valid packet" $ parsePacket decrypted @?= packet_expected