Permalink
Browse files

Cleaning new code for serial port communication.

  • Loading branch information...
1 parent f1492e0 commit 2f88b6f506c041475597882fe2173dfe24d0f7e3 @mitar committed Jan 11, 2012
View
92 NXT.cabal
@@ -1,5 +1,5 @@
Name: NXT
-Version: 0.1.9
+Version: 0.2.0
Synopsis: A Haskell interface to Lego Mindstorms NXT
Description: A Haskell interface to Lego Mindstorms NXT over Bluetoooth. It supports direct commands, messages and
many sensors (also unofficial). It has also support for a simple message-based control of a NXT brick
@@ -8,24 +8,23 @@ Description: A Haskell interface to Lego Mindstorms NXT over Bluetoooth.
It contains two simple programs: @nxt-upload@ for uploading files to a NXT brick and @nxt-shutdown@ for
remote shutdown of a NXT brick.
.
- It should work on Linux, MacOs and Windows.
+ It works on Linux, Mac OS X and Windows.
.
Feel free to contribute additional features, interfaces for more sensors and propose or write other
(example) programs.
License: LGPL-3
License-file: LICENSE
Author: Mitar Milutinovic
Maintainer: mitar.haskell@tnode.com
-Copyright: (c) 2010 Mitar Milutinovic
+Copyright: (c) 2011 Mitar Milutinovic
Category: Robotics
Build-type: Simple
-Cabal-version: >= 1.8
+Cabal-version: >= 1.10
Stability: experimental
Homepage: http://mitar.tnode.com
Extra-source-files: remote/remote.rxe,
remote/remote.nxc,
- ffi/blue.h,
- ffi/initserial.h
+ ffi/blue.h
Library
Exposed-modules: Robotics.NXT,
@@ -37,8 +36,7 @@ Library
mtl >= 1.1 && < 3,
bytestring >= 0.9 && < 1,
time >= 1.1 && < 2,
- serialport,
- transformers
+ serialport >= 0.4 && < 1
Other-modules: Robotics.NXT.Data,
Robotics.NXT.Errors,
Robotics.NXT.Protocol,
@@ -50,59 +48,53 @@ Library
GHC-options: -Wall
GHC-prof-options: -Wall
GHC-shared-options: -Wall
+ Default-language: Haskell2010
+ C-sources: ffi/blue.c
+ Includes: ffi/blue.h
if !os(windows)
- Build-depends: unix >= 2.4 && < 3
+ Build-depends: unix >= 2.4 && < 3
- if !os(windows)
- C-sources: ffi/blue.c,
- ffi/initserial.c
- Includes: ffi/blue.h,
- ffi/initserial.h
- Extra-libraries: bluetooth
+ if os(linux)
+ Extra-libraries: bluetooth
Source-repository head
- type: mercurial
- location: https://bitbucket.org/mitar/nxt
+ type: mercurial
+ location: https://bitbucket.org/mitar/nxt
Executable nxt-shutdown
- Main-is: Shutdown.hs
- HS-source-dirs: src
- Build-depends: base >= 4.3 && < 5,
+ Main-is: Shutdown.hs
+ HS-source-dirs: src
+ Build-depends: base >= 4.3 && < 5,
mtl >= 1.1 && < 3,
- NXT,
- transformers,
- serialport
- GHC-options: -Wall
+ NXT == 0.2.0
+ GHC-options: -Wall
+ Default-language: Haskell2010
Executable nxt-upload
- Main-is: UploadFiles.hs
- HS-source-dirs: src
- Build-depends: base >= 4.3 && < 5,
+ Main-is: UploadFiles.hs
+ HS-source-dirs: src
+ Build-depends: base >= 4.3 && < 5,
mtl >= 1.1 && < 3,
bytestring >= 0.9 && < 1,
filepath >= 1.1 && < 2,
- NXT,
- transformers,
- serialport
- GHC-options: -Wall
-
-
-Test-suite NXTTests
- Type: exitcode-stdio-1.0
- x-uses-tf: true
- Build-depends: base >= 4,
- HUnit >= 1.2 && < 2,
- QuickCheck >= 2.4,
- test-framework >= 0.4.1,
- test-framework-quickcheck2,
- test-framework-hunit,
- NXT,
- transformers,
- serialport,
- mtl
- GHC-options: -Wall -rtsopts
- HS-source-dirs: test
- Main-is: Main.hs
- Other-modules: Robotics.NXT.Basic
+ NXT == 0.2.0
+ GHC-options: -Wall
+ Default-language: Haskell2010
+Test-suite nxt-tests
+ Type: exitcode-stdio-1.0
+ X-uses-tf: true
+ Build-depends: base >= 4,
+ HUnit >= 1.2 && < 2,
+ QuickCheck >= 2.4 && < 3,
+ test-framework >= 0.4 && < 1,
+ test-framework-quickcheck2 >= 0.2 && < 1,
+ test-framework-hunit >= 0.2 && < 1,
+ mtl >= 1.1 && < 3,
+ NXT == 0.2.0
+ GHC-options: -Wall -rtsopts
+ Default-language: Haskell2010
+ HS-source-dirs: tests
+ Main-is: Main.hs
+ Other-modules: Robotics.NXT.Basic
View
29 ffi/initserial.c
@@ -1,29 +0,0 @@
-#include <termios.h>
-#include <unistd.h>
-
-#include "initserial.h"
-
-// A simple function which initializes serial port device: 8 bit data, one stop bit, RTS/CTS flow control
-
-int initSerialPort(int fd) {
- struct termios params;
-
- tcflush(fd, TCIOFLUSH);
-
- if (tcgetattr(fd, &params) == -1) return -1;
-
- cfmakeraw(&params);
-#ifdef __MAX_BAUD
- cfsetspeed(&params, __MAX_BAUD);
-#elif defined B230400
- cfsetspeed(&params, B230400);
-#endif
- params.c_cflag = CLOCAL | CREAD | CS8 | HUPCL | CRTSCTS;
-
- //params.c_cc[VTIME] = (5000 + 50) / 100;
- //params.c_cc[VMIN] = 0;
-
- if (tcsetattr(fd, TCSANOW, &params) == -1) return -1;
-
- return 0;
-}
View
6 ffi/initserial.h
@@ -1,6 +0,0 @@
-#ifndef INITSERIAL_H_
-#define INITSERIAL_H_
-
-int initSerialPort(int fd);
-
-#endif /* INITSERIAL_H_ */
View
7 lib/Robotics/NXT/BluetoothUtils.hs
@@ -1,13 +1,12 @@
-{-# LANGUAGE CPP #-}
+{-# LANGUAGE ForeignFunctionInterface #-}
+{-# CFILES ffi/blue.c #-}
module Robotics.NXT.BluetoothUtils (
-- * Bluetooth utils
-- | `getDeviceInfo` returns zero for Bluetooth signal strength as this is not implemented in current NXT firmware versions.
-- Here are functions which retrieve that from a host (computer) Bluetooth stack.
-#ifdef linux_HOST_OS
bluetoothRSSI,
bluetoothLinkQuality
-#endif
) where
import Control.Exception
@@ -20,7 +19,6 @@ import Robotics.NXT.Protocol
import Robotics.NXT.Types
import Robotics.NXT.Internals
-#ifdef linux_HOST_OS
-- Foreign function call for C function which returns RSSI Bluetooth value of a connection to a given Bluetooth address
foreign import ccall unsafe "rssi" rssi :: CString -> IO CInt
@@ -74,7 +72,6 @@ bluetoothLinkQualityAddr addr = do
| ret' == blueNotConnected -> liftIO $ throwIO $ NXTException "Connection not established"
| ret' == blueNotSupported -> liftIO $ throwIO $ NXTException "Not supported on this system"
| otherwise -> return ret'
-#endif
bluetoothAddress :: NXT BTAddress
bluetoothAddress = do
View
8 lib/Robotics/NXT/Externals.hs
@@ -1,8 +1,12 @@
+{-# LANGUAGE DeriveDataTypeable #-}
+
module Robotics.NXT.Externals where
+import Control.Exception
import Data.Int
import Data.Ratio
import Data.Time.Clock
+import Data.Typeable
import Data.Word
-- Described in Lego Mindstorms NXT Bluetooth Developer Kit:
@@ -171,3 +175,7 @@ type ModuleHandle = Int -- unsigned byte
type IOMapOffset = Int -- unsigned word
type IOMapLength = Int -- unsigned word
type IOMapData = [Word8]
+
+-- | Timeout exception for NXT IO operations.
+data TimeoutException = TimoutException deriving (Show, Typeable)
+instance Exception TimeoutException
View
2 lib/Robotics/NXT/Internals.hs
@@ -5,7 +5,7 @@ module Robotics.NXT.Internals where
import Control.Monad.State
import Data.Time.Clock.POSIX
import Data.Typeable
-import System.Hardware.Serialport (SerialPort)
+import System.Hardware.Serialport
import Robotics.NXT.Externals
View
81 lib/Robotics/NXT/Protocol.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE CPP #-}
+
module Robotics.NXT.Protocol (
-- * Initialization
withNXT,
@@ -99,22 +101,20 @@ module Robotics.NXT.Protocol (
execNXT
) where
---import qualified Data.ByteString as B
import Control.Exception
import Control.Monad.State
-import Control.Monad.Trans.Maybe
import Data.Bits
import Data.Char
import Data.List hiding (delete)
import Data.Maybe
import Data.Ratio
import Data.Time.Clock.POSIX
import Data.Word
---import Foreign.C.Error
---import Foreign.C.Types
import System.IO
-import System.Hardware.Serialport (openSerial,defaultSerialSettings,sendString ,recvChar,closeSerial,commSpeed ,timeout, CommSpeed(CS19200) , flush)
---import System.Posix.Types
+import System.Hardware.Serialport hiding (One)
+#ifndef windows_HOST_OS
+import System.Posix.Signals
+#endif
import Text.Printf
import Robotics.NXT.Data
@@ -130,12 +130,6 @@ import Robotics.NXT.Internals
-- TODO: Add an optional warning if direction of communication changes
-- TODO: Implement all missing "confirm" versions of functions
--- Foreign function call for C function which initialize serial port device on POSIX systems
---foreign import ccall unsafe "initSerialPort" initSerialPort' :: Fd -> IO CInt
---
---initSerialPort :: Fd -> IO ()
---initSerialPort fd = throwErrnoIfMinus1_ "initSerialPort" $ initSerialPort' fd
-
{-|
Default Bluetooth serial device filename for current operating system. Currently always @\/dev\/rfcomm0@.
-}
@@ -150,18 +144,17 @@ Opens and intializes a Bluetooth serial device communication.
-}
initialize :: FilePath -> IO NXTInternals
initialize device = do
- s <- openSerial device defaultSerialSettings { commSpeed = CS19200,timeout=1000 }
-
--- -- we have to block signals from interrupting openFd system call (fixed in GHC versions after 6.12.1)
--- let signals = foldl (flip addSignal) emptySignalSet [virtualTimerExpired]
--- blockSignals signals
--- fd <- openFd device ReadWrite Nothing OpenFileFlags { append = False, noctty = True, exclusive = False, nonBlock = True, trunc = False }
--- unblockSignals signals
--- initSerialPort fd
--- h <- fdToHandle fd
--- hSetBuffering h NoBuffering
+#ifndef windows_HOST_OS
+ -- we have to block signals from interrupting openFd system call (fixed in GHC versions after 6.12.1)
+ let signals = foldl (flip addSignal) emptySignalSet [virtualTimerExpired]
+ blockSignals signals
+#endif
+ h <- openSerial device defaultSerialSettings { commSpeed = CS115200, timeout = 1000 }
+#ifndef windows_HOST_OS
+ unblockSignals signals
+#endif
when debug $ hPutStrLn stderr "initialized"
- return $ NXTInternals s Nothing [] Nothing Nothing
+ return $ NXTInternals h Nothing [] Nothing Nothing
{-|
Stops all NXT activities (by calling 'stopEverything') and closes the Bluetooth serial device communication. 'NXTInternals' token must not
@@ -192,42 +185,26 @@ sendData message = do
h <- getsNXT nxthandle
let len = toUWord . length $ message
packet = len ++ message
- --liftIO . B.hPut h . B.pack $ packet
liftIO $ sendString h $ map (toEnum . fromEnum) packet
when debug $ liftIO . hPutStrLn stderr $ "sent: " ++ show packet
-- Main function for receiving data from NXT
receiveData :: NXT [Word8]
receiveData = do
h <- getsNXT nxthandle
- --len <- liftIO $ B.hGet h 2
- --let len' = fromUWord . B.unpack $ len
- --packet <- liftIO $ B.hGet h len'
- --let unpacket = B.unpack packet
--- unpacket<-liftIO (do
--- mc1<-recvChar h
--- case mc1 of
--- Just c1-> do
--- mc2<-recvChar h
--- case mc2 of
--- Just c2-> do
--- let len' = fromUWord $ map (toEnum . fromEnum) [c1, c2]
--- when debug $ liftIO . hPutStrLn stderr $ "received length: " ++ show len'
--- fs<-mapM (\_->recvChar h) [1..len']
--- return $ map fromJust fs
--- Nothing->return ""
--- Nothing-> return ""
--- )
- unpacket<-runMaybeT $ do
- c1<-MaybeT $ liftIO $ recvChar h
- c2<-MaybeT $ liftIO $ recvChar h
- let len' = fromUWord $ map (toEnum . fromEnum) [c1, c2]
- when debug $ liftIO . hPutStrLn stderr $ "received length: " ++ show len'
- fs<-mapM (\_->liftIO $ recvChar h) [1..len']
- return $ map fromJust fs
- let ws=map (toEnum . fromEnum) (fromMaybe "" unpacket)
- when debug $ liftIO . hPutStrLn stderr $ "received: " ++ show ws
- return ws
+ let hChar :: IO Word8
+ hChar = do
+ c <- recvChar h
+ case c of
+ Just c' -> return $ toEnum . fromEnum $ c'
+ Nothing -> throwIO TimoutException
+ hGet :: Int -> IO [Word8]
+ hGet l = replicateM l hChar
+ len <- liftIO $ hGet 2
+ let len' = fromUWord len
+ packet <- liftIO $ hGet len'
+ when debug $ liftIO . hPutStrLn stderr $ "received: " ++ show packet
+ return packet
{-|
Gets firmware and protocol versions of the NXT brick.
View
76 test/Main.hs → tests/Main.hs
@@ -1,40 +1,38 @@
-
-module Main where
-
-import Robotics.NXT
-import Robotics.NXT.Basic
-
-import Control.Exception
-import Control.Monad.State.Class
-
-import Test.Framework (defaultMainWithArgs, testGroup,Test)
-import Test.Framework.Providers.HUnit
-
-
+module Main where
+
+import Robotics.NXT
+import Robotics.NXT.Basic
+
+import Control.Exception
+import Control.Monad.State.Class
+
+import Test.Framework (defaultMainWithArgs, testGroup,Test)
+import Test.Framework.Providers.HUnit
+
+
import System.Environment ( getArgs)
-import Data.IORef
-import Control.Monad.IO.Class (liftIO)
-
-main :: IO()
-main = do
- (device:args) <- getArgs
- bracket (do
- i<-initialize device
- newIORef i)
- (\ref->do
- i'<-readIORef ref
- terminate i')
- (\ref->defaultMainWithArgs (tests ref) args)
-
--- withNXT device (do
--- i<-get
--- ref<-liftIO $ newIORef i
--- liftIO $ defaultMainWithArgs (tests ref) args
--- i'<-liftIO $ readIORef ref
--- return ()
--- )
-
-tests :: IORef (NXTInternals) -> [Test]
-tests ref= [testGroup "Basic Tests" (concatMap hUnitTestToTests (basicTests ref))
- ]
-
+import Data.IORef
+import Control.Monad.IO.Class (liftIO)
+
+main :: IO()
+main = do
+ (device:args) <- getArgs
+ bracket (do
+ i<-initialize device
+ newIORef i)
+ (\ref->do
+ i'<-readIORef ref
+ terminate i')
+ (\ref->defaultMainWithArgs (tests ref) args)
+
+-- withNXT device (do
+-- i<-get
+-- ref<-liftIO $ newIORef i
+-- liftIO $ defaultMainWithArgs (tests ref) args
+-- i'<-liftIO $ readIORef ref
+-- return ()
+-- )
+
+tests :: IORef (NXTInternals) -> [Test]
+tests ref= [testGroup "Basic Tests" (concatMap hUnitTestToTests (basicTests ref))
+ ]
View
123 test/Robotics/NXT/Basic.hs → tests/Robotics/NXT/Basic.hs
@@ -1,62 +1,61 @@
-
-module Robotics.NXT.Basic where
-
-import Robotics.NXT
-import Test.HUnit
-
-import Control.Concurrent (threadDelay)
-import Data.IORef
-
-basicTests :: IORef NXTInternals -> [Test]
-basicTests d= map (\x->x d) [testDeviceInfo,testOutputState,testInputMode]
---
-
-delay :: IO()
-delay =threadDelay $ 1000000 * 30
-
-testNXT :: IORef NXTInternals -> NXT a -> IO a
-testNXT ref f=do
- i<-readIORef ref
- (a,i')<-runNXT f i
- writeIORef ref i'
- return a
-
-
-testDeviceInfo :: IORef NXTInternals -> Test
-testDeviceInfo ref= TestLabel "testDeviceInfo" (TestCase (do
- (DeviceInfo name address _ _)<-testNXT ref getDeviceInfo
- assertBool "empty name" (not $ null name)
- putStrLn ("NXT Name: "++name)
- assertBool "empty address" (not $ null address)
- putStrLn ("NXT Address: "++address)
- ))
-
-testOutputState :: IORef NXTInternals -> Test
-testOutputState ref= TestLabel "testOutputState" (TestCase (do
- (OutputState port power modes reg ratio _ limit count _ _) <- testNXT ref (do
- setOutputStateConfirm A 75 [MotorOn,Brake] RegulationModeMotorSpeed 0 MotorRunStateRunning 360
- getOutputState A
- )
- assertEqual "not A port" A port
- assertEqual "not 75 power" 75 power
- assertEqual "not modes" [MotorOn,Brake] modes
- assertEqual "not regulation" RegulationModeMotorSpeed reg
- assertEqual "not 0 ratio" 0 ratio
- assertEqual "not 360 limit" 360 limit
- assertBool "count>0" (count>0)
- ))
-
-testInputMode :: IORef NXTInternals -> Test
-testInputMode ref= TestLabel "testInputMode" (TestCase (do
- InputValue port valid calibrated stype smode _ normV scalV _<-testNXT ref (do
- setInputModeConfirm One Switch BooleanMode
- getInputValues One
- )
- assertEqual "not port 1" One port
- assertBool "not valid" valid
- assertBool "calibrated" (not calibrated)
- assertEqual "not switch" Switch stype
- assertEqual "not boolean" BooleanMode smode
- assertBool "normalized not in range" (normV>=0 && normV<1024)
- assertEqual "scaled not 0" 0 scalV
- ))
+module Robotics.NXT.Basic where
+
+import Robotics.NXT
+import Test.HUnit
+
+import Control.Concurrent (threadDelay)
+import Data.IORef
+
+basicTests :: IORef NXTInternals -> [Test]
+basicTests d= map (\x->x d) [testDeviceInfo,testOutputState,testInputMode]
+--
+
+delay :: IO()
+delay =threadDelay $ 1000000 * 30
+
+testNXT :: IORef NXTInternals -> NXT a -> IO a
+testNXT ref f=do
+ i<-readIORef ref
+ (a,i')<-runNXT f i
+ writeIORef ref i'
+ return a
+
+
+testDeviceInfo :: IORef NXTInternals -> Test
+testDeviceInfo ref= TestLabel "testDeviceInfo" (TestCase (do
+ (DeviceInfo name address _ _)<-testNXT ref getDeviceInfo
+ assertBool "empty name" (not $ null name)
+ putStrLn ("NXT Name: "++name)
+ assertBool "empty address" (not $ null address)
+ putStrLn ("NXT Address: "++address)
+ ))
+
+testOutputState :: IORef NXTInternals -> Test
+testOutputState ref= TestLabel "testOutputState" (TestCase (do
+ (OutputState port power modes reg ratio _ limit count _ _) <- testNXT ref (do
+ setOutputStateConfirm A 75 [MotorOn,Brake] RegulationModeMotorSpeed 0 MotorRunStateRunning 360
+ getOutputState A
+ )
+ assertEqual "not A port" A port
+ assertEqual "not 75 power" 75 power
+ assertEqual "not modes" [MotorOn,Brake] modes
+ assertEqual "not regulation" RegulationModeMotorSpeed reg
+ assertEqual "not 0 ratio" 0 ratio
+ assertEqual "not 360 limit" 360 limit
+ assertBool "count>0" (count>0)
+ ))
+
+testInputMode :: IORef NXTInternals -> Test
+testInputMode ref= TestLabel "testInputMode" (TestCase (do
+ InputValue port valid calibrated stype smode _ normV scalV _<-testNXT ref (do
+ setInputModeConfirm One Switch BooleanMode
+ getInputValues One
+ )
+ assertEqual "not port 1" One port
+ assertBool "not valid" valid
+ assertBool "calibrated" (not calibrated)
+ assertEqual "not switch" Switch stype
+ assertEqual "not boolean" BooleanMode smode
+ assertBool "normalized not in range" (normV>=0 && normV<1024)
+ assertEqual "scaled not 0" 0 scalV
+ ))

0 comments on commit 2f88b6f

Please sign in to comment.