diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/apps/Dump.hs b/apps/Dump.hs new file mode 100644 --- /dev/null +++ b/apps/Dump.hs @@ -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 diff --git a/apps/FFT.hs b/apps/FFT.hs new file mode 100644 --- /dev/null +++ b/apps/FFT.hs @@ -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 diff --git a/apps/Headmap.hs b/apps/Headmap.hs new file mode 100644 --- /dev/null +++ b/apps/Headmap.hs @@ -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 diff --git a/apps/Mouse.hs b/apps/Mouse.hs new file mode 100644 --- /dev/null +++ b/apps/Mouse.hs @@ -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) diff --git a/bench/Bench.hs b/bench/Bench.hs new file mode 100644 --- /dev/null +++ b/bench/Bench.hs @@ -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" diff --git a/hemokit.cabal b/hemokit.cabal new file mode 100644 --- /dev/null +++ b/hemokit.cabal @@ -0,0 +1,160 @@ +name: hemokit +version: 0.4.0 +license: MIT +copyright: 2013 Niklas Hambüchen , Patrick Chilton +author: Niklas Hambüchen , Patrick Chilton +maintainer: Niklas Hambüchen +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 + (), 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 diff --git a/src/Hemokit.hs b/src/Hemokit.hs new file mode 100644 --- /dev/null +++ b/src/Hemokit.hs @@ -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 diff --git a/src/Hemokit/Start.hs b/src/Hemokit/Start.hs new file mode 100644 --- /dev/null +++ b/src/Hemokit/Start.hs @@ -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) diff --git a/test/Tests.hs b/test/Tests.hs new file mode 100644 --- /dev/null +++ b/test/Tests.hs @@ -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