diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,79 @@ +hemokit +======= + +Haskell library and tool suite for the [Emotiv](http://emotiv.com) Epoc EEG, inspired by the [Emokit](https://github.com/openyou/emokit) code. + +It currently only works on Linux and Windows - patches for other platforms are welcome, they should be trivial. + + +Download +-------- + +You can download [pre-built binaries here](https://github.com/nh2/hemokit/releases), or build it yourself via [`cabal install hemokit`](http://hackage.haskell.org/package/hemokit). + + +Library Features +---------------- + +* device discovery via [hidapi](https://github.com/vahokif/haskell-hidapi) +* decryption of the raw data (one-to-one port from from Emokit) +* convenient access to sensor values, gyro, qualities, battery, and raw data + + +Programs +-------- + +Hemokit comes with example programs to + +* `hemokit-dump` print out the current EEG data +* `hemokit-mouse` move the cursor using the gyro + +Note that we have to use `sudo` in most of the cases because the HIDAP-hidraw implementation reads directly from a device file. + + +hemokit-dump - Examples +----------------------- + +*hemokit-dump* can print EEG data, format it as JSON, serve it via Websockets, and read from real devices and dump files. + + +* Output EEG *cumulative state* for an automatically found device: + + ```bash + sudo hemokit-dump + ``` + +* Select one of many connected EEGs by serial number: + + ```bash + sudo hemokit-dump --serial SN...GM + ``` + +* Output only the data the device sends (no cumulative state), and format the output as JSON: + + ```bash + sudo hemokit-dump --mode packets --json + ``` + +* Instead of from a real device, read data recorded to a file, and serve it via JSON over a Websockets server on port `1234`: + + ```bash + sudo cat /dev/hidraw1 > encrypted.dump # Dump data to a file + sudo hemokit-dump --from-file encrypted.dump --serial SN...GM --serve 0.0.0.0:1234 --json + ``` + + Here you **have** to specify the serial since HIDAPI is not used to obtain it automatically. + +* Output decrypted raw data to stdout: + + ```bash + sudo hemokit-dump --mode raw + ``` + +* Both print the data from the EEG **and** store the original data for later use: + + ```bash + sudo cat /dev/hidraw1 | tee >(hemokit-dump --from-file - --serial SN...GM --json) > encrypted.dump + ``` + + We use `tee` and shell process substitution to duplicate the data stream, and tell *hemokit-dump* to read from `-` (stdin). diff --git a/apps/Dump.hs b/apps/Dump.hs --- a/apps/Dump.hs +++ b/apps/Dump.hs @@ -8,12 +8,17 @@ import Data.Aeson (ToJSON (..), encode) import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy.Char8 as BSL8 +import qualified Data.ByteString.Lazy as BSL +import qualified Data.ByteString.Lazy.Builder as Builder +import qualified Data.ByteString.Lazy.Builder.ASCII as Builder import qualified Data.ByteString.Base64 as Base64 import Data.Function (fix) import Data.IORef import Data.List import Data.List.Split (splitOn) import Data.Time.Clock +import Data.Monoid +import qualified Data.Vector as V import Options.Applicative hiding (action) import System.IO import Text.Read @@ -23,7 +28,8 @@ import Hemokit.Start import Hemokit.Internal.Utils (withJustM) -import WebsocketUtils (makeJsonOrShowWSServer, JsonShowable (..)) +import SocketUtils (makeTCPServer) +import WebsocketUtils (makeWSServer) -- | Arguments for the EEG dump application. @@ -32,15 +38,23 @@ , mode :: DumpMode -- ^ What to dump. , realtime :: Bool -- ^ In case fromFile is used, throttle to 128 Hz. , 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. + , format :: OutputFormat -- ^ How to print the output. + , serve :: Maybe ServeMethod -- ^ Serve via TCP or websockets on host:port. } -- | Whether to dump raw data, hardware-sent packages, cumulative states, -- or measurements of device-computer latency. -data DumpMode = Raw | Packets | State | Measure deriving (Eq, Show) +data DumpMode = Raw | Packets | State | Measure deriving (Eq, Ord, Show) +-- | In what format to print the output. +-- `Default` is raw bytes to stdout for `Raw` mode and `show` for everything else. +data OutputFormat = Default | Json | Spaced deriving (Eq, Ord, Show) +-- | Whether to serve via plain TCP or Websockets (hostname and port). +data ServeMethod + = TCP String Int + | Websocket String Int + -- | Parser for `DumpArgs`. dumpArgsParser :: Parser DumpArgs dumpArgsParser = DumpArgs @@ -55,14 +69,16 @@ <*> switch ( long "list" <> help "Show all available Emotiv devices and exit" ) - <*> switch - ( long "json" - <> help "Format output as JSON" ) + <*> nullOption + ( long "format" + <> reader parseOutputFormat <> value Default + <> help "Format output as Haskell value, JSON or space-separated" ) <*> (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)") ) + <> help ("Serve output via a TCP server, e.g. 127.0.0.1:1234 " ++ + "(port 1234, only localhost) or 0.0.0.0:1234 (all interfaces). " ++ + "Use 'ws://' before the host to serve via websockets") ) where -- TODO https://github.com/pcapriotti/optparse-applicative/issues/48 eitherReader str2either = reader (either fail return . str2either) @@ -77,30 +93,55 @@ "measure" -> return Measure _ -> fail "Mode is not valid. Must be 'raw', 'packets', or 'state'." +-- | `OutputFormat` command line parser. +parseOutputFormat :: Monad m => String -> m OutputFormat +parseOutputFormat s = case s of + "default"-> return Default + "json" -> return Json + "spaced" -> return Spaced + _ -> fail "Format is not valid. Must be 'default', 'json', or 'spaced'." + -- | 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 +parseHostPort :: String -> Either String ServeMethod +parseHostPort hostPortWs = case readMaybe portStr of Nothing -> Left $ show portStr ++ " is not a valid port number" - Just p -> Right (host, p) + Just p -> Right $ if ws then Websocket host p + else TCP host p where + (ws, hostPort) = case stripPrefix "ws://" hostPortWs of + Just rest -> (True, rest) + Nothing -> (False, hostPortWs) + (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) +whitespaceFormat :: EmotivState -> BSL.ByteString +whitespaceFormat EmotivState{ counter, battery, gyroX, gyroY, sensors, qualities } + = Builder.toLazyByteString . mconcat + . intersperse (Builder.char8 ' ') . map Builder.intDec $ ints + where + ints = [ counter, battery, gyroX, gyroY ] ++ V.toList sensors ++ V.toList qualities + main :: IO () main = do DumpArgs{ emotivArgs , mode , realtime , listDevices - , json + , format , serve } <- parseArgs "Dumps Emotiv data" dumpArgsParser + -- Catch invalid mode/format combinations immediately + -- (so that we don't block first and error afterwards, see `formatOutput`). + when (format == Spaced && mode /= State) $ + error $ "cannot space-format in " ++ show mode ++ " mode" + if listDevices -- Only list devices then getEmotivDevices >>= putStrLn . ("Available devices:\n" ++) . ppShow else do @@ -112,12 +153,20 @@ Left err -> error err Right device -> do + let formatOutput x = case format of + Default -> BSL8.pack (show x) + Json -> encode x + Spaced -> error "hemokit-dump BUG: formatOutput/spaced not caught early" + -- 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 -- TODO use Data.ByteString.Lazy.UTF8.fromString instead of BSL8 to prevent unicode errors - Nothing -> return (BSL8.putStrLn . if json then encode else BSL8.pack . show) - Just (host, port) -> makeJsonOrShowWSServer host port json + Nothing -> return (\x -> BSL8.putStrLn x >> hFlush stdout) + Just (Websocket host port) -> do sendFn <- makeWSServer host port + return sendFn + Just (TCP host port) -> do sendFn <- makeTCPServer host port + return sendFn -- For --mode measure: See how long a 0-128 cycle takes timeRef <- newIORef =<< getCurrentTime @@ -132,27 +181,32 @@ moreInput <- case mode of Packets -> readEmotiv device `withJustM` \(_, packet) -> - output (JsonShowable packet) + output $ formatOutput packet State -> readEmotiv device `withJustM` \(state, _) -> - output (JsonShowable state) + case format of + Spaced -> output $ whitespaceFormat state + _ -> output $ formatOutput state Raw -> readEmotivRaw device `withJustM` \rawBytes -> do - if json then output (JsonShowable rawBytes) - else BS.putStr (emotivRawDataBytes rawBytes) - hFlush stdout -- flush so that consuming apps immediately get it + case format of + Default -> -- raw data stdout; flush so that consuming apps immediately get it + BS.putStr (emotivRawDataBytes rawBytes) >> hFlush stdout + _ -> -- use EmotivRawData newtype for base64 encoding + output $ formatOutput rawBytes + Measure -> readEmotivRaw device `withJustM` \_ -> do -- When a full cycle is done, print how long it took. count <- readIORef countRef modifyIORef' countRef (+1) when (count == 128) $ do cycleTime <- diffUTCTime <$> getCurrentTime <*> readIORef timeRef - output . JsonShowable $ toDoule cycleTime + output . formatOutput $ toDouble cycleTime writeIORef countRef 0 writeIORef timeRef =<< getCurrentTime where - toDoule x = fromRational (toRational x) :: Double + toDouble x = fromRational (toRational x) :: Double -- When realtime is on, throttle the reading to 1/129 (a real diff --git a/apps/DumpConduit.hs b/apps/DumpConduit.hs --- a/apps/DumpConduit.hs +++ b/apps/DumpConduit.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE NamedFieldPuns, ExistentialQuantification #-} +{-# LANGUAGE NamedFieldPuns #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Main where @@ -8,7 +8,10 @@ import Control.Monad.IO.Class import Data.Aeson (ToJSON (..), encode) import qualified Data.ByteString as BS +import qualified Data.ByteString.Lazy as BSL import qualified Data.ByteString.Lazy.Char8 as BSL8 +import qualified Data.ByteString.Lazy.Builder as Builder +import qualified Data.ByteString.Lazy.Builder.ASCII as Builder import qualified Data.ByteString.Base64 as Base64 import Data.Conduit import qualified Data.Conduit.List as CL @@ -17,6 +20,8 @@ import Data.List import Data.List.Split (splitOn) import Data.Time.Clock +import Data.Monoid +import qualified Data.Vector as V import Options.Applicative hiding (action) import System.IO import Text.Read @@ -33,15 +38,23 @@ , mode :: DumpMode -- ^ What to dump. , realtime :: Bool -- ^ In case fromFile is used, throttle to 128 Hz. , 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. + , format :: OutputFormat -- ^ How to print the output. + , serve :: Maybe ServeMethod -- ^ Serve via TCP or websockets on host:port. } -- | Whether to dump raw data, hardware-sent packages, cumulative states, -- or measurements of device-computer latency. -data DumpMode = Raw | Packets | State | Measure deriving (Eq, Show) +data DumpMode = Raw | Packets | State | Measure deriving (Eq, Ord, Show) +-- | In what format to print the output. +-- `Default` is raw bytes to stdout for `Raw` mode and `show` for everything else. +data OutputFormat = Default | Json | Spaced deriving (Eq, Ord, Show) +-- | Whether to serve via plain TCP or Websockets (hostname and port). +data ServeMethod + = TCP String Int + | Websocket String Int + -- | Parser for `DumpArgs`. dumpArgsParser :: Parser DumpArgs dumpArgsParser = DumpArgs @@ -56,14 +69,16 @@ <*> switch ( long "list" <> help "Show all available Emotiv devices and exit" ) - <*> switch - ( long "json" - <> help "Format output as JSON" ) + <*> nullOption + ( long "format" + <> reader parseOutputFormat <> value Default + <> help "Format output as Haskell value, JSON or space-separated" ) <*> (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)") ) + <> help ("Serve output via a TCP server, e.g. 127.0.0.1:1234 " ++ + "(port 1234, only localhost) or 0.0.0.0:1234 (all interfaces). " ++ + "Use 'ws://' before the host to serve via websockets") ) where -- TODO https://github.com/pcapriotti/optparse-applicative/issues/48 eitherReader str2either = reader (either fail return . str2either) @@ -78,30 +93,55 @@ "measure" -> return Measure _ -> fail "Mode is not valid. Must be 'raw', 'packets', or 'state'." +-- | `OutputFormat` command line parser. +parseOutputFormat :: Monad m => String -> m OutputFormat +parseOutputFormat s = case s of + "default"-> return Default + "json" -> return Json + "spaced" -> return Spaced + _ -> fail "Format is not valid. Must be 'default', 'json', or 'spaced'." + -- | 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 +parseHostPort :: String -> Either String ServeMethod +parseHostPort hostPortWs = case readMaybe portStr of Nothing -> Left $ show portStr ++ " is not a valid port number" - Just p -> Right (host, p) + Just p -> Right $ if ws then Websocket host p + else TCP host p where + (ws, hostPort) = case stripPrefix "ws://" hostPortWs of + Just rest -> (True, rest) + Nothing -> (False, hostPortWs) + (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) +whitespaceFormat :: EmotivState -> BSL.ByteString +whitespaceFormat EmotivState{ counter, battery, gyroX, gyroY, sensors, qualities } + = Builder.toLazyByteString . mconcat + . intersperse (Builder.char8 ' ') . map Builder.intDec $ ints + where + ints = [ counter, battery, gyroX, gyroY ] ++ V.toList sensors ++ V.toList qualities + main :: IO () main = do DumpArgs{ emotivArgs , mode , realtime , listDevices - , json + , format , serve } <- parseArgs "Dumps Emotiv data" dumpArgsParser + -- Catch invalid mode/format combinations immediately + -- (so that we don't block first and error afterwards, see `formatOutput`). + when (format == Spaced && mode /= State) $ + error $ "cannot space-format in " ++ show mode ++ " mode" + if listDevices -- Only list devices then getEmotivDevices >>= putStrLn . ("Available devices:\n" ++) . ppShow else do @@ -113,27 +153,37 @@ Left err -> error err Right device -> do - -- Print to stdout or serve via websockets? Show the datatype or format via JSON? - let outputSink :: (ToJSON i, Show i) => Sink i IO () + let -- Show the datatype or format via JSON? + formatConduit :: (ToJSON i, Show i) => Conduit i IO BSL.ByteString + formatConduit = case format of + Default -> CL.map (BSL8.pack . show) + Json -> CL.map encode + Spaced -> error "hemokit-dump BUG: formatOutput/spaced not caught early" + + -- Print to stdout or serve via websockets? outputSink = case serve of - Nothing | json -> asJson =$ CL.mapM_ BSL8.putStrLn - | otherwise -> CL.mapM_ print - Just (host, port) | json -> asJson =$ websocketSink host port - | otherwise -> websocketSink host port - where - asJson = CL.map encode + Nothing -> CL.mapM_ BSL8.putStrLn + Just (Websocket host port) -> websocketSink host port + Just (TCP host port) -> tcpSink host port + -- Prints raw bytes to stdout + rawBytesSink = CL.mapM_ (putStrBsFlush . emotivRawDataBytes) + throttled = if realtime then ($= throttle) else id -- Output accumulative state, device-sent packet, or raw data? case mode of - Packets -> throttled (emotivPackets device) $$ outputSink + Packets -> throttled (emotivPackets device) $$ formatConduit =$ outputSink - State -> throttled (emotivStates device) $$ outputSink + State -> throttled (emotivStates device) $$ case format of + Spaced -> CL.map whitespaceFormat =$ outputSink + _ -> formatConduit =$ outputSink - Raw -> throttled (rawSource device) $$ if json then outputSink - else CL.mapM_ (putStrBsFlush . emotivRawDataBytes) - Measure -> throttled (rawSource device) $= measureConduit $$ outputSink + Raw -> throttled (rawSource device) $$ case format of + Default -> rawBytesSink + _ -> formatConduit =$ outputSink -- use EmotivRawData newtype for base64 encoding + + Measure -> throttled (rawSource device) $= measureConduit $$ formatConduit =$ outputSink where putStrBsFlush bs = BS.putStr bs >> hFlush stdout diff --git a/apps/SocketUtils.hs b/apps/SocketUtils.hs new file mode 100644 --- /dev/null +++ b/apps/SocketUtils.hs @@ -0,0 +1,34 @@ +module SocketUtils + ( tcpServerFromChan + , makeTCPServerChan + , makeTCPServer + ) where + +import Control.Concurrent +import Control.Monad +import qualified Data.ByteString.Lazy as BSL +import Network.Simple.TCP + + +-- | A TCP server that serves ByteStrings from a Chan. +tcpServerFromChan :: Chan BSL.ByteString -> (Socket, SockAddr) -> IO () +tcpServerFromChan chan = \(sock, _remoteAddr) -> do + c <- dupChan chan + forever (readChan c >>= send sock . BSL.toStrict) + + +-- | Creates and starts (forking) a ByteString-serving TCP server. +-- Returns a Chan from which the server will read. +makeTCPServerChan :: String -> Int -> IO (Chan BSL.ByteString) +makeTCPServerChan host port = do + chan <- newChan + _ <- forkIO $ withSocketsDo $ serve (Host host) (show port) (tcpServerFromChan chan) + return chan + + +-- | Creates and starts (forking) a ByteString-serving TCP server. +-- Returns a function that serves the contents. +makeTCPServer :: String -> Int -> IO (BSL.ByteString -> IO ()) +makeTCPServer host port = do + chan <- makeTCPServerChan host port + return (writeChan chan) diff --git a/apps/WebsocketUtils.hs b/apps/WebsocketUtils.hs --- a/apps/WebsocketUtils.hs +++ b/apps/WebsocketUtils.hs @@ -1,48 +1,35 @@ -{-# LANGUAGE ExistentialQuantification #-} - module WebsocketUtils - ( jsonWSServerFromChan - , makeJsonWSServer - , makeJsonOrShowWSServer - , JsonShowable (..) + ( wsServerFromChan + , makeWSServerChan + , makeWSServer ) where import Control.Concurrent import Control.Monad -import Data.Aeson (ToJSON(..), encode) +import qualified Data.ByteString.Lazy as BSL import Network.WebSockets --- | A websocket server that serves JSON from a Chan. -jsonWSServerFromChan :: (ToJSON a) => Chan a -> PendingConnection -> IO () -jsonWSServerFromChan chan = \req -> do +-- | A websocket server that serves ByteStrings from a Chan. +wsServerFromChan :: Chan BSL.ByteString -> PendingConnection -> IO () +wsServerFromChan chan = \req -> do conn <- acceptRequest req c <- dupChan chan - forever (readChan c >>= sendTextData conn . encode) + forever (readChan c >>= sendTextData conn) --- | Creates and starts (forking) a JSON-serving websocket server. +-- | Creates and starts (forking) a ByteString-serving websocket server. -- Returns a Chan from which the server will read. -makeJsonWSServer :: (ToJSON a) => String -> Int -> IO (Chan a) -makeJsonWSServer host port = do +makeWSServerChan :: String -> Int -> IO (Chan BSL.ByteString) +makeWSServerChan host port = do chan <- newChan - _ <- forkIO $ runServer host port (jsonWSServerFromChan chan) + _ <- forkIO $ runServer host port (wsServerFromChan chan) return chan --- | Creates a server that can serve things either as text or as JSON. --- If `json` is true, inputs to the returned function will be sent as JSON, --- otherwise they will be `show`n and then JSON-formatted as a String. -makeJsonOrShowWSServer :: (Show a, ToJSON a) => String -> Int -> Bool -> IO (a -> IO ()) -makeJsonOrShowWSServer host port json = - if json then do chan <- makeJsonWSServer host port - return (writeChan chan) - else do chan <- makeJsonWSServer host port - return (writeChan chan . show) - - --- | Something that can be shown and formatted as JSON. -data JsonShowable = forall a . (Show a, ToJSON a) => JsonShowable a - -instance Show JsonShowable where show (JsonShowable x) = show x -instance ToJSON JsonShowable where toJSON (JsonShowable x) = toJSON x +-- | Creates and starts (forking) a ByteString-serving websocket server. +-- Returns a function that serves the contents. +makeWSServer :: String -> Int -> IO (BSL.ByteString -> IO ()) +makeWSServer host port = do + chan <- makeWSServerChan host port + return (writeChan chan) diff --git a/hemokit.cabal b/hemokit.cabal --- a/hemokit.cabal +++ b/hemokit.cabal @@ -1,5 +1,5 @@ name: hemokit -version: 0.5.1 +version: 0.6.0 license: MIT copyright: 2013 Niklas Hambüchen , Patrick Chilton author: Niklas Hambüchen , Patrick Chilton @@ -36,11 +36,24 @@ in both their plain form and as JSON, and optionally serve any of this via Websockets. +extra-source-files: + README.md + source-repository head type: git location: git://github.com/nh2/hemokit.git +flag fft + description: Enable apps that use FFT. Needs fftw installed. + +flag headmap + description: Build the headmap. Needs GUI libraries installed. + +flag mouse + description: Build the app that controls the mouse with the gyroscope. Needs Xorg and related libraries installed (so it only works on Linux for now). + + library exposed-modules: Hemokit @@ -55,8 +68,9 @@ , conduit >= 1 , deepseq >= 1.2 , deepseq-generics >= 0.1 - , hidapi >= 0.1.1 + , hidapi >= 0.1.2 , mtl >= 2.1.2 + , network-simple >= 0.3.0 , optparse-applicative >= 0.5.2.1 , vector >= 0.9 , websockets >= 0.8.0.0 @@ -67,17 +81,20 @@ executable hemokit-mouse + if !flag(mouse) + buildable: False 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 + if flag(mouse) + build-depends: + base + , hemokit + , pretty-show >= 1.0 + , robot >= 1.0.1.1 + , xhb >= 0.5.2012.11.23 ghc-options: -Wall @@ -88,6 +105,7 @@ main-is: Dump.hs other-modules: + SocketUtils WebsocketUtils build-depends: base @@ -95,11 +113,13 @@ , aeson >= 0.6.1.0 , base64-bytestring >= 1.0.0.1 , bytestring >= 0.9.2.1 + , network-simple >= 0.3.0 , optparse-applicative >= 0.5.2.1 , pretty-show >= 1.0 , split >= 0.2.2 - , time >= 1.4.0.1 + , time >= 1.4 , transformers >= 0.3.0.0 + , vector >= 0.9 , websockets >= 0.8.0.0 ghc-options: -Wall @@ -117,46 +137,54 @@ , base64-bytestring >= 1.0.0.1 , bytestring >= 0.9.2.1 , conduit >= 1 + , network-simple >= 0.3.0 , optparse-applicative >= 0.5.2.1 , pretty-show >= 1.0 , split >= 0.2.2 - , time >= 1.4.0.1 + , time >= 1.4 , transformers >= 0.3.0.0 + , vector >= 0.9 ghc-options: -Wall executable hemokit-fft + if !flag(fft) + buildable: False 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 + if flag(fft) + 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 + if !flag(headmap) + buildable: False 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 + if flag(headmap) + 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 diff --git a/src/Hemokit.hs b/src/Hemokit.hs --- a/src/Hemokit.hs +++ b/src/Hemokit.hs @@ -86,11 +86,11 @@ -- -- 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) +data EmotivModel = Consumer | Developer deriving (Eq, Ord, Show, Generic) -- | A valid Emotiv serial number. 16 bytes. -newtype SerialNumber = SerialNumber ByteString deriving (Eq, Show, Generic) +newtype SerialNumber = SerialNumber ByteString deriving (Eq, Ord, Show, Generic) -- | Checks an Emotiv serial, returning a `SerialNumber` if it's valid. makeSerialNumber :: ByteString -> Maybe SerialNumber @@ -145,7 +145,7 @@ -- | Describes the indices of bits to make up a certain value. -newtype BitMask = BitMask [Word8] deriving (Eq, Show) +newtype BitMask = BitMask [Word8] deriving (Eq, Ord, Show) -- | Describes which bits in a raw data packet make up the given sensor. getSensorMask :: Sensor -> BitMask @@ -270,7 +270,7 @@ , 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) + } deriving (Eq, Ord, Show, Generic) -- | Contains the "current state" of the EEG, cumulateively updated by @@ -282,13 +282,13 @@ , 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) + } deriving (Eq, Ord, Show, Generic) -- | Wraps (unencrypted) Emotiv raw data. Ensures that it is 32 bytes. newtype EmotivRawData = EmotivRawData { emotivRawDataBytes :: ByteString - } deriving (Eq, Show, Generic) + } deriving (Eq, Ord, Show, Generic) -- | Treat a `ByteString` as Emotiv raw data. diff --git a/src/Hemokit/Conduit.hs b/src/Hemokit/Conduit.hs --- a/src/Hemokit/Conduit.hs +++ b/src/Hemokit/Conduit.hs @@ -6,7 +6,9 @@ import Control.Monad.Trans import Data.Aeson (ToJSON (..), encode) import Data.ByteString.Lazy (ByteString) +import qualified Data.ByteString.Lazy as BSL import Data.Conduit +import qualified Network.Simple.TCP as TCP import qualified Network.WebSockets as WS import Hemokit @@ -37,9 +39,30 @@ jsonConduit = awaitForever (yield . encode) +-- * TCP sockets + +tcpSink :: (MonadIO m) => String -> Int -> Sink ByteString m () +tcpSink host port = do + chan <- liftIO $ newChan + + -- Server loop: Send what comes in via the chan; Nothing shuts down + let jsonTCPServerFromChan :: (TCP.Socket, TCP.SockAddr) -> IO () + jsonTCPServerFromChan = \(sock, _remoteAddr) -> do + void $ untilNothing (readChan chan) (TCP.send sock . BSL.toStrict) + + -- Fork off Websocket server + _ <- liftIO $ forkIO $ TCP.withSocketsDo $ TCP.serve (TCP.Host host) (show port) jsonTCPServerFromChan + + -- Send messages to server via the chan + void $ awaitForever (liftIO . writeChan chan . Just) + + -- Tell server to shut down + liftIO $ writeChan chan Nothing + + -- * Websockets -websocketSink :: (MonadIO m, ToJSON a) => String -> Int -> Sink a m () +websocketSink :: (MonadIO m) => String -> Int -> Sink ByteString m () websocketSink host port = do chan <- liftIO $ newChan @@ -47,7 +70,7 @@ let jsonWSServerFromChan :: WS.PendingConnection -> IO () jsonWSServerFromChan = \req -> do conn <- WS.acceptRequest req - void $ untilNothing (readChan chan) (WS.sendTextData conn . encode) + void $ untilNothing (readChan chan) (WS.sendTextData conn) -- Fork off Websocket server _ <- liftIO $ forkIO $ WS.runServer host port jsonWSServerFromChan diff --git a/src/Hemokit/Start.hs b/src/Hemokit/Start.hs --- a/src/Hemokit/Start.hs +++ b/src/Hemokit/Start.hs @@ -27,7 +27,7 @@ -- 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) + } deriving (Eq, Ord, Show) -- | EEG model command line parser. @@ -86,5 +86,7 @@ Nothing -> fail $ "No device with serial " ++ show s Just d -> Right <$> openEmotivDevice model d + -- TODO Do smarter auto detection, e.g. filter for Emotiv vendorIDs + -- or the "EPOC BCI" product string. -- The user selected no serial, we just use the last device _ -> Right <$> openEmotivDevice model (last devices)